home *** CD-ROM | disk | FTP | other *** search
/ Delphi 2 - Developers' Solutions / Delphi 2 Developers' Solutions.iso / dds / chap03 / howto08 / delphi10 / drwsutl3.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-10-24  |  127.4 KB  |  3,473 lines
  1. unit Drwsutl3;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls, ShellAPI, FileCtrl, DRWSUtl1;
  8.  
  9. const
  10.   EOC_CHANGEDIR = 1;  { Error Operation Code for change directory failure }
  11.   EOC_SOURCECOPY = 2; { Error Operation Code for source copy failure      }
  12.   EOC_DESTCOPY = 3;   { Error Operation Code for destination copy failure }
  13.   EOC_DELETEFILE = 4; { Error Operation Code for file delete failure      }
  14.   EOC_DELETEDIR = 5;  { Error Operation Code for directory delete failure }
  15.   EOC_RENAMEFILE = 6; { Error Operation Code for renaming failure         }
  16.   EOC_MAKEDIR = 7;    { Error Operation Code for MkDir failure            }
  17.   EOC_SETATTR = 8;    { Error Operation Code for Set Attributes failure   }
  18.  
  19.   FAC_COPY = 1;       { File Action Code for recursive copying            }
  20.   FAC_MOVE = 2;       { File Action Code for recursive moving             }
  21.   FAC_DELETE = 3;     { File Action Code for recursive deletion           }
  22.  
  23.   KBMJ_SINGLE = 1;   { Keyboard mouse motion constant for single pixel moves }
  24.   KBMJ_SMALL = 10;    { Keyboard mouse motion constant for single pixel moves }
  25.   KBMJ_LARGE = 50;    { Keyboard mouse motion constant for single pixel moves }
  26.  
  27.   CR_KEYSET = 6; { ID for special keypress cursor }
  28.   CR_NULL = 7;   { ID for Null (blank) cursor     }
  29. type
  30.   { This is a descendant of TFileListbox }
  31.   { Which puts icons of files into the   }
  32.   { Objects array rather than the stand- }
  33.   { ard bitmaps.                         }
  34.   TIconFileListBox = class( TFileListBox )
  35.   public
  36.     { public methods and data }
  37.     procedure ReadFileNames; override;
  38.     function GetNextSelection( SourceDirectory : String;
  39.               var CurrentItem : Integer ) : String;
  40.     constructor Create(AOwner : TComponent); override; { override create    }
  41.     procedure TheDblClick( Sender : TObject );{ This holds override dblclick }
  42.   end;
  43.   TFileWorkBench = class( TComponent )
  44.   public
  45.     GlobalError        : Integer;  { This is used by FMXUCopyFile for er code }
  46.     GlobalErrorType    : Integer;  { This holds the Operation code            }
  47.     function ForceTrailingBackSlash( const TheFileName : String ) : String;
  48.     function StripNonRootTrailingBackSlash(
  49.               const TheFileName : String ) : String;
  50.     procedure GetFileAttributes( TheFile : String; var IsDirectory , IsArchive ,
  51.                 IsVolumeID , IsHidden , IsReadOnly , IsSysFile : Boolean );
  52.     procedure HandleIOException( TheOpCode : Integer; ThePath : String;
  53.                                  TheMessage : String; TheCode : Integer );
  54.     procedure HandleDOSError( TheOpCode : Integer; ThePath : String;
  55.                 TheCode : Integer );
  56.     function CopyFile( TargetPath ,
  57.                DestinationPath : String ) : Boolean;
  58.     procedure ChangeTheDirectory( NewPath : String );
  59.     procedure ChangeTheDriveAndDirectory( NewDrive : Integer );
  60.     procedure CopyTheFile( OldPath , NewPath : String );
  61.     procedure MoveTheFile( OldPath , NewPath : String );
  62.     procedure DeleteTheFile( ThePath : String );
  63.     procedure RenameTheFile( OldPath , NewName : String );
  64.     procedure CreateNewDirectory( NewPath : String );
  65.     procedure RemoveDirectory( ThePath : String );
  66.     procedure SetFileAttributes( TheFile  : String; TheAttributes : Integer );
  67.     procedure RecursivelyCopyDirectory( OldPath , NewPath : String );
  68.     procedure RecursivelyMoveDirectory( OldPath , NewPath : String );
  69.     procedure RecursivelyDeleteDirectory( ThePath : String );
  70.     procedure HandleRecursiveAction( StartingPath , NewPath : String;
  71.                ActionCode : Integer );
  72.   end;
  73.   TFileIconPanel = class( TPanel )
  74.   private
  75.     { Private declarations }
  76.     FHighlightColor : TColor;                 { This holds bright edge bevel }
  77.     FShadowColor    : TColor;                 { This holds dark edge bevel   }
  78.     procedure TheMouseDown(Sender: TObject;
  79.       Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  80.     procedure TheMouseMove( Sender: TObject; Shift: TShiftState;
  81.       X, Y: Integer);
  82.     procedure TheMouseUp(Sender: TObject;
  83.       Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  84.     procedure WMLButtonDblClk(var Message: TWMLButtonDblClk);
  85.      message WM_LBUTTONDBLCLK;
  86.     procedure TheDragOver(Sender, Source: TObject; X,
  87.       Y: Integer; State: TDragState; var Accept: Boolean);
  88.     procedure TheDragDrop(Sender, Source: TObject; X,
  89.       Y: Integer);
  90.   protected                                   { event method procedure.      }
  91.     { Protected declarations }
  92.     procedure Paint; override;                { This allows custom painting  }
  93.   public
  94.     { Public declarations }
  95.     FTheIcon : TIcon;                         { This is the display icon    }
  96.     FTheName : String;                        { This is the filename        }
  97.     FTheLabel : TLabel;                       { This is the display label   }
  98.     Selected : Boolean;                       { This holds selection status }
  99.     constructor Create(AOwner : TComponent); override; { override create    }
  100.     procedure Initialize( PanelX              ,             { Left          }
  101.                           PanelY              ,             { Top           }
  102.                           PanelWidth          ,             { Width         }
  103.                           PanelHeight         ,             { Height        }
  104.                           PanelBevelWidth     ,             { Bevel Width   }
  105.                           LabelFontSize         : Integer;  { Font size     }
  106.                           PanelColor          ,             { Main color    }
  107.                           PanelHighlightColor ,             { Bright color  }
  108.                           PanelShadowColor    ,             { Dark color    }
  109.                           LabelTextColor        : TColor;   { Text color    }
  110.                           TheFilename         ,             { Filename      }
  111.                           LabelFontName         : String;   { Font name     }
  112.                           LabelFontStyle        : TFontStyles;  { Font style}
  113.                           ExtraData             : Integer       );  { Drive }
  114.     destructor Destroy; override;             { override destroy to free    }
  115.   end;
  116.   TFileIconPanelScrollBox = class( TScrollBox )
  117.   public
  118.     { Public methods and data }
  119.     TheFWB              : TFileWorkBench; { Used for file manipulation         }
  120.     IconsNeedRefreshing : Boolean;                   { Flag to redo display    }
  121.     TheIconSize        : Integer;   { Holds Individual Icon size               }
  122.     TheIconSpacing     : Integer;   { Holds total icon footprint               }
  123.     MaxIconsInARow     : Integer;   { Set for screen size.                     }
  124.     TheStoredHandle    : HWnd;
  125.     TheParentForm      : TForm;
  126.     procedure Update;                                { Called to reset display }
  127.     constructor Create( AOwner : TComponent ); override;  { Override inherited }
  128.     procedure ClearTheFIPs;                          { Clears the FIPs safely  }
  129.     procedure AddDriveIcons( var XCounter , YCounter : Integer ); { Add drives }
  130.     procedure GetColorsForFileIcon( TheFile : String;
  131.                var BC , HC , SC , TC : TColor );
  132.     procedure GetIconsForEntireDirectory( TargetPath  : String );
  133.     function GetNextSelection( SourceDirectory : String;
  134.               var CurrentItem : Integer ) : String;
  135.     procedure DisplayRecursiveSearchResults(
  136.       TheStartingDirectory : String );
  137.   end;
  138.   TIOManager = class( TComponent )
  139.   public
  140.     Parent : TForm;
  141.     WhichButton : TMouseButton;
  142.     WhichState  : TShiftState;
  143.     CLState ,
  144.     NLState ,
  145.     SLState   : Boolean;
  146.     function IsCapsLockDown : Boolean;
  147.     function ISNumLockDown : Boolean;
  148.     function IsScrollLockDown : Boolean;
  149.     procedure InitLocks;
  150.     procedure ReadLocks( var TheCL , TheNL , TheSL : Boolean );
  151.     procedure SetLocks( TheCL , TheNL , TheSL : Boolean );
  152.     function WasLeftPressed : Boolean;
  153.     function WasRightPressed : Boolean;
  154.     function WasMiddlePressed : Boolean;
  155.     function WasALTPressed : Boolean;
  156.     function WasSHIFTPressed : Boolean;
  157.     function WasCTRLPressed : Boolean;
  158.     procedure OnF1Pressed(Sender: TObject; var Key: Word;
  159.      Shift: TShiftState);
  160.     procedure OnF2Pressed(Sender: TObject; var Key: Word;
  161.      Shift: TShiftState);
  162.     procedure OnF3Pressed(Sender: TObject; var Key: Word;
  163.      Shift: TShiftState);
  164.     procedure OnF4Pressed(Sender: TObject; var Key: Word;
  165.      Shift: TShiftState);
  166.     procedure OnF5Pressed(Sender: TObject; var Key: Word;
  167.      Shift: TShiftState);
  168.     procedure OnF6Pressed(Sender: TObject; var Key: Word;
  169.      Shift: TShiftState);
  170.     procedure OnF7Pressed(Sender: TObject; var Key: Word;
  171.      Shift: TShiftState);
  172.     procedure OnF8Pressed(Sender: TObject; var Key: Word;
  173.      Shift: TShiftState);
  174.     procedure OnF9Pressed(Sender: TObject; var Key: Word;
  175.      Shift: TShiftState);
  176.     procedure OnF10Pressed(Sender: TObject; var Key: Word;
  177.      Shift: TShiftState);
  178.     procedure OnF11Pressed(Sender: TObject; var Key: Word;
  179.      Shift: TShiftState);
  180.     procedure OnF12Pressed(Sender: TObject; var Key: Word;
  181.      Shift: TShiftState);
  182.  end;
  183.  TMouseManager = class( TComponent )
  184.  public
  185.    TheMX : Integer;
  186.    TheMY : Integer;
  187.    Old_X ,
  188.    Old_Y ,
  189.    New_X ,
  190.    New_Y   : Integer;
  191.    StoredCursor : Integer;
  192.    BitmapCursor  : Boolean;
  193.    IconCursor    : Boolean;
  194.    CursorBMP     : TBitmap;
  195.    CursorIcon    : TIcon;
  196.    IsAnimated    : Boolean;
  197.    TheTimer      : TTimer;
  198.    TheAnimationList : TList;
  199.    CurrentAnimationPointer : Integer;
  200.    AnimationInterval : Integer;
  201.    SavedDC ,
  202.    GlobalDC : HDC;
  203.    GlobalCanvas : TCanvas;
  204.    WorkSpaceBMP : TBitmap;
  205.    BackGroundBMP : TBitmap;
  206.    constructor Create( AOwner : TComponent ); override;
  207.    destructor Destroy; override;
  208.    procedure InitializeNormal;
  209.    procedure InitializeBitmap( TheBmp : TBitmap );
  210.    procedure InitializeIcon( TheIcon : TIcon );
  211.    procedure InitializeAnimated( TheIcon : TIcon; TheInterval : Integer;
  212.                                  TheIconList : TList );
  213.    procedure GetMousePosition( var MouseX , MouseY : Integer );
  214.    procedure SetMousePosition( MouseX , MouseY : Integer );
  215.    procedure MoveSinglePixelLeft;
  216.    procedure MoveSinglePixelRight;
  217.    procedure MoveSinglePixelUp;
  218.    procedure MoveSinglePixelDown;
  219.    procedure MoveSmallJumpLeft;
  220.    procedure MoveSmallJumpRight;
  221.    procedure MoveSmallJumpUp;
  222.    procedure MoveSmallJumpDown;
  223.    procedure MoveLargeJumpLeft;
  224.    procedure MoveLargeJumpRight;
  225.    procedure MoveLargeJumpUp;
  226.    procedure MoveLargeJumpDown;
  227.    procedure StartBitmapCursor( TheX , TheY : Integer );
  228.    procedure MoveBitmapCursor( TheX , TheY : Integer );
  229.    procedure EndBitmapCursor( TheX , TheY : Integer );
  230.    procedure StartIconCursor( TheX , TheY : Integer );
  231.    procedure MoveIconCursor( TheX , TheY : Integer );
  232.    procedure EndIconCursor( TheX , TheY : Integer );
  233.    procedure StartAnimatedIconCursor( TheX , TheY : Integer );
  234.    procedure EndAnimatedIconCursor( TheX , TheY : Integer );
  235.    procedure MoveAnimatedIconCursor( TheX , TheY : Integer );
  236.    procedure TimerAction( Sender : TObject );
  237.  end;
  238.  
  239.   { This procedure gets an icon for a file using FindExecutable  }
  240.   { and ExtractIcon. (assumes file/dir is passed)                }
  241.   procedure GetIconForFile( TheName : String; var TheIcon : TIcon );
  242.   { This procedure spaces out the bitbtn components on a tpanel }
  243.   procedure SpacePanelButtons( WhichPanel : TPanel );
  244.     procedure FMXUCopyFile(const FileName, DestName: String; var GlobalErrorType ,
  245.                GlobalErrorCode : Integer );
  246.  
  247. var TheIOManager : TIOManager;
  248.     TheMouseManager : TMouseManager;
  249.     GlobalAbortFlag : Boolean;
  250.     SavedForm : TForm;
  251.     SavedControl : TFileIconPanel;
  252.     OtherSavedControl : TFileIconPanelScrollbox;
  253.     Savedhandle : HWnd;
  254.     IconDragging : boolean;
  255.     GlobalSource : TObject;
  256.     TheTempBitmap : TBitmap;
  257.     BitmapDragging : boolean;
  258.  
  259. implementation
  260. {$R DRWSUTL3.RES}                 { Import custom resource file }
  261. uses UFMGR17;
  262.  
  263. { It has been edited to return viable error codes!             }
  264. procedure FMXUCopyFile(const FileName, DestName: String; var GlobalErrorType ,
  265.             GlobalErrorCode : Integer );
  266. var
  267.   CopyBuffer: Pointer; { buffer for copying }
  268.   BytesCopied: Longint;
  269.   TheAttr : Integer;
  270.   Source, Dest: Integer; { handles }
  271. const
  272.   ChunkSize: Longint = 8192; { copy in 8K chunks }
  273. begin
  274.   GetMem(CopyBuffer, ChunkSize); { allocate the buffer }
  275.   Source := FileOpen(FileName, fmShareDenyWrite); { open source file }
  276.   if Source < 0 then
  277.   begin  { error creating source file }
  278.     GlobalErrorType := EOC_SOURCECOPY;
  279.     GlobalErrorCode := -IOResult;
  280.     if GlobalErrorCode = 0 then GlobalErrorCode := -157;
  281.     FreeMem( CopyBuffer, ChunkSize );
  282.     exit;
  283.   end;
  284.   Dest := FileCreate(DestName); { create output file; overwrite existing }
  285.   if Dest < 0 then
  286.   begin  { error creating destination file }
  287.     FileClose( Source );
  288.     GlobalErrorType := EOC_DESTCOPY;
  289.     GlobalErrorCode := -IOResult;
  290.     if GlobalErrorCode = 0 then GlobalErrorCode := -159;
  291.     FreeMem( CopyBuffer , ChunkSize );
  292.     exit;
  293.   end;
  294.   {$I-}
  295.   repeat
  296.     BytesCopied := FileRead(Source, CopyBuffer^, ChunkSize); { read chunk}
  297.     if BytesCopied > 0 then { if we read anything... }
  298.     FileWrite(Dest, CopyBuffer^, BytesCopied); { ...write chunk }
  299.   until BytesCopied < ChunkSize; { until we run out of chunks }
  300.   {$I+}
  301.   GlobalErrorCode := -IOResult;  { get any error code which happens during copying }
  302.   FileClose(Dest); { close the destination file }
  303.   FileClose(Source); { close the source file }
  304.   FreeMem(CopyBuffer, ChunkSize); { free the buffer }
  305. end;
  306.  
  307. { This procedure spaces out the bitbtn components on a tpanel }
  308. procedure SpacePanelButtons( WhichPanel : TPanel );
  309. var TheCalculatedSpacing     ,            { Holds primary spacing }
  310.     TheFullCalculatedSpacing   : Integer; { Holds full spacing    }
  311.     Counter_1                  : Integer; { Loop counter          }
  312.     TotalIBs                   : Integer; { Gets total buttons    }
  313. begin
  314.   { Set up spacing values }
  315.   TotalIBs := WhichPanel.ControlCount;
  316.   TheCalculatedSpacing := (( WhichPanel.Width - 6 - ( TotalIbs * 49 ))
  317.    div ( TotalIbs + 1 ));
  318.   TheFullCalculatedSpacing := TheCalculatedSpacing + 49;
  319.   { Loop through all imported buttons and set their Left values }
  320.   for Counter_1 := 1 to WhichPanel.ControlCount do
  321.   begin
  322.     if Counter_1 = 1 then
  323.     begin
  324.       TBitBtn( WhichPanel.Controls[ Counter_1 - 1 ] ).Left := 3 +
  325.        TheCalculatedSpacing;
  326.     end
  327.     else
  328.     begin
  329.       TBitBtn( WhichPanel.Controls[ Counter_1 - 1 ] ).Left := 3 +
  330.        (( Counter_1 - 1 ) * TheFullCalculatedSpacing ) + TheCalculatedSpacing;
  331.     end;
  332.   end;
  333. end;
  334.  
  335. { This procedure gets an icon for a file using FindExecutable  }
  336. { and ExtractIcon. (assumes file/dir is passed)                }
  337. procedure GetIconForFile( TheName : String; var TheIcon : TIcon );
  338. var TheExt           : String; { File extension holder }
  339.     TheOtherPChar  ,           { Windows ASCIIZ string }
  340.     TheResultPChar ,           { Windows ASCIIZ string }
  341.     ThePChar         : PChar;  { Windows ASCIIZ string }
  342. begin
  343.   { Check for directory and if so get directory icon from RES file }
  344.   if (( FileGetAttr( TheName ) and faDirectory ) = faDirectory ) then
  345.   begin
  346.     { Set up the PChar to communicate with Windows }
  347.     GetMem( TheOtherPChar , 255 );
  348.     { Convert Pascal-style string to ASCIIZ Pchar }
  349.     StrPCopy( TheOtherPChar , 'DIRECTORY' );
  350.     { Use API call to return icon handle of Icon Resource in FILECTRL.RES }
  351.     TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  352.     { Release memory from PChar }
  353.     FreeMem( TheOtherPChar , 255 );
  354.     { Leave }
  355.     exit;
  356.   end;
  357.   { Assume archive file; get its extension }
  358.   TheExt := Uppercase( ExtractFileExt( TheName ));
  359.   { If not an executable/image file then use FindExecutable to get icon }
  360.   if (( TheExt <> '.EXE' ) and ( TheExt <> '.BAT' ) and
  361.       ( TheExt <> '.PIF' ) and ( TheExt <> '.COM' )) then
  362.   begin
  363.     { Grab three chunks of memory }
  364.     GetMem( TheOtherPChar , 255 );
  365.     GetMem( TheResultPChar , 255 );
  366.     GetMem( ThePChar , 255 );
  367.     { Set up the name and its directory in Windows string formats }
  368.     StrPCopy( ThePChar, TheName );
  369.     StrPCopy( TheOtherPChar , ExtractFilePath( TheName ));
  370.     { Use FindExecutable API call to get path and name of owning file }
  371.     if FindExecutable( ThePChar , TheOtherPChar , TheResultPChar ) > 31 then
  372.     begin
  373.       { If get a result of 32 or more then try to get first icon of owner }
  374.       { Using ExtractIcon API call; 0 indicates first icon.               }
  375.       TheIcon.Handle := ExtractIcon( hInstance , TheResultPchar , 0 );
  376.       { If a handle is 0 then no icon in owner, get default icon from RES file }
  377.       if TheIcon.Handle = 0 then
  378.       begin
  379.         GetMem( TheOtherPChar , 255 );
  380.         StrPCopy( TheOtherPChar , 'NOICON' );
  381.         TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  382.         FreeMem( TheOtherPChar , 255 );
  383.         exit;
  384.       end;
  385.     end
  386.     else
  387.     { if no assigned executable, then get default icon from RES file }
  388.     begin
  389.       GetMem( TheOtherPChar , 255 );
  390.       StrPCopy( TheOtherPChar , 'NOICON' );
  391.       TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  392.       FreeMem( TheOtherPChar , 255 );
  393.       exit;
  394.     end;
  395.     FreeMem( TheOtherPChar , 255 );
  396.     FreeMem( TheResultPChar , 255 );
  397.     FreeMem( ThePChar , 255 );
  398.   end
  399.   else
  400.   { Assume Windows Executable file, so get icon from it with ExtractIcon API }
  401.   begin
  402.     GetMem( ThePChar , 255 );
  403.     StrPCopy( ThePChar , TheName );
  404.     { If no icons in file then get default icon (note use FFFF for -1) }
  405.     if ExtractIcon( hInstance , ThePchar , 65535 ) = 0 then
  406.     begin
  407.       Freemem( ThePChar , 255 );
  408.       GetMem( TheOtherPChar , 255 );
  409.       StrPCopy( TheOtherPChar , 'NOICON' );
  410.       TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  411.       FreeMem( TheOtherPChar , 255 );
  412.       exit;
  413.     end
  414.     else
  415.     begin
  416.       { Try to get first icon for file }
  417.       TheIcon.Handle := ExtractIcon( hInstance , ThePChar , 0 );
  418.       FreeMem( ThePChar , 255 );
  419.       { If handle is 0 invalid icon format so use default from RES file }
  420.       if TheIcon.Handle = 0 then
  421.       begin
  422.         GetMem( TheOtherPChar , 255 );
  423.         StrPCopy( TheOtherPChar , 'NOICON' );
  424.         TheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  425.         FreeMem( TheOtherPChar , 255 );
  426.         exit;
  427.       end;
  428.     end;
  429.   end;
  430. end;
  431.  
  432. { This creates the TMouseManager and inits vars to null }
  433. constructor TMouseManager.Create( AOwner : TComponent );
  434. begin
  435.   { Call inherited FIRST! }
  436.   inherited Create( AOwner );
  437.   { Set all variables to 0 , false or nil }
  438.   TheMX := 0;
  439.   TheMY := 0;
  440.   Old_X  := 0;
  441.   Old_Y  := 0;
  442.   New_X  := 0;
  443.   New_Y  := 0;
  444.   StoredCursor := 0;
  445.   BitmapCursor  := false;
  446.   IconCursor    := false;
  447.   CursorBMP     := nil;
  448.   CursorIcon    := nil;
  449.   IsAnimated    := false;
  450.   TheTimer      := nil;
  451.   TheAnimationList := nil;
  452.   CurrentAnimationPointer := 0;
  453.   AnimationInterval := 0;
  454.   SavedDC := 0;
  455.   GlobalDC := 0;
  456.   GlobalCanvas := nil;
  457.   WorkSpaceBMP := nil;
  458.   BackGroundBMP := nil;
  459. end;
  460.  
  461. { This destroys the tmousemanager and releases all resources }
  462. destructor TMouseManager.Destroy;
  463. begin
  464.   { Free any assigned resources (the moving bmp ones already are gone) }
  465.   if assigned( TheTimer ) then
  466.    TheTimer.Free;
  467.   if assigned( TheAnimationList ) then
  468.    TheAnimationList.Free;
  469.   Inherited Destroy;
  470. end;
  471.  
  472. { This sets up the mouse manager for normal cursor operations }
  473. procedure TMouseManager.InitializeNormal;
  474. var TheMP : TPoint;
  475. begin
  476.   { Reset State Variables }
  477.   BitmapCursor := false;
  478.   IconCursor := false;
  479.   IsAnimated := false;
  480.   { Call API to get mouse coordinates }
  481.   GetCursorPos( TheMP );
  482.   { Store the coordinates for later use }
  483.   TheMX := TheMP.X;
  484.   TheMY := TheMP.Y;
  485.   Old_X := TheMX;
  486.   Old_Y := TheMY;
  487.   New_X := TheMX;
  488.   New_Y := TheMY;
  489. end;
  490.  
  491. { This procedure initializes a bitmap cursor }
  492. procedure TMouseManager.InitializeBitmap( TheBmp : TBitmap );
  493. begin
  494.   InitializeNormal;
  495.   CursorBMP := TheBMP;
  496.   BitmapCursor := true;
  497. end;
  498.  
  499. { This procedure initalizes an icon cursor }
  500. procedure TMouseManager.InitializeIcon( TheIcon : TIcon );
  501. begin
  502.   InitializeNormal;
  503.   CursorIcon := TheIcon;
  504.   IconCursor := true;
  505. end;
  506.  
  507. { This procedure initializes an animated icon cursor }
  508. procedure TMouseManager.InitializeAnimated( TheIcon : TIcon;
  509.            TheInterval : Integer; TheIconList : TList );
  510. begin
  511.   InitializeNormal;
  512.   CursorIcon := TheIcon;
  513.   IconCursor := true;
  514.   IsAnimated := true;
  515.   AnimationInterval := TheInterval;
  516.   TheAnimationList := TheIconList;
  517.   TheTimer := TTimer.Create( Self );
  518.   TheTimer.Enabled := false;
  519.   TheTimer.Interval := AnimationInterval;
  520.   TheTimer.OnTimer := TimerAction;
  521. end;
  522.  
  523. { This procedure returns the current stored mouse position }
  524. procedure TMouseManager.GetMousePosition( var MouseX , MouseY : Integer );
  525. begin
  526.   { Return stored position rather than call API }
  527.   MouseX := TheMX;
  528.   MouseY := TheMY;
  529. end;
  530.  
  531. { This procedure sets the Mouse Position internally }
  532. procedure TMouseManager.SetMousePosition( MouseX , MouseY : Integer );
  533. begin
  534.   { Set internal coordinates; don't call API }
  535.   TheMX := MouseX;
  536.   TheMY := MouseY;
  537. end;
  538.  
  539. { This procedure is used to drive the mouse with the keyboard }
  540. procedure TMouseManager.MoveSinglePixelLeft;
  541. begin
  542.   { Use internal coordinates and check for screen wrapping }
  543.   if TheMX > KBMJ_SINGLE then
  544.   begin
  545.     { Not wrapped; move along one unit to the left }
  546.     TheMX := TheMX - KBMJ_SINGLE;
  547.     SetCursorPos( TheMX , TheMY );
  548.   end
  549.   else
  550.   begin
  551.     { Wrapped; jump to right and move back one unit }
  552.     TheMX := Screen.Width - KBMJ_SINGLE;
  553.     SetCursorPos( TheMX , TheMY );
  554.   end;
  555. end;
  556.  
  557. { This procedure is used to drive the mouse with the keyboard }
  558. procedure TMouseManager.MoveSinglePixelRight;
  559. begin
  560.   { Use internal coordinates and check for screen wrapping }
  561.   if TheMX < ( Screen.Width - KBMJ_SINGLE ) then
  562.   begin
  563.     { Not wrapped; move along one unit to the right }
  564.     TheMX := TheMX + KBMJ_SINGLE;
  565.     SetCursorPos( TheMX , TheMY );
  566.   end
  567.   else
  568.   begin
  569.     { Wrapped; jump to left and move in one unit }
  570.     TheMX := KBMJ_SINGLE;
  571.     SetCursorPos( TheMX , TheMY );
  572.   end;
  573. end;
  574.  
  575. { This procedure is used to drive the mouse with the keyboard }
  576. procedure TMouseManager.MoveSinglePixelUp;
  577. begin
  578.   { Use internal coordinates and check for screen wrapping }
  579.   if TheMY > KBMJ_SINGLE then
  580.   begin
  581.     { Not wrapped; move along one unit to the top }
  582.     TheMY := TheMY - KBMJ_SINGLE;
  583.     SetCursorPos( TheMX , TheMY );
  584.   end
  585.   else
  586.   begin
  587.     { Wrapped; jump to bottom and move back one unit }
  588.     TheMY := Screen.Height - KBMJ_SINGLE;
  589.     SetCursorPos( TheMX , TheMY );
  590.   end;
  591. end;
  592.  
  593. { This procedure is used to drive the mouse with the keyboard }
  594. procedure TMouseManager.MoveSinglePixelDown;
  595. begin
  596.   { Use internal coordinates and check for screen wrapping }
  597.   if TheMY < ( Screen.Height - KBMJ_SINGLE ) then
  598.   begin
  599.     { Not wrapped; move along one unit to the bottom }
  600.     TheMY := TheMY + KBMJ_SINGLE;
  601.     SetCursorPos( TheMX , TheMY );
  602.   end
  603.   else
  604.   begin
  605.     { Wrapped; jump to top and move back one unit }
  606.     TheMY := KBMJ_SINGLE;
  607.     SetCursorPos( TheMX , TheMY );
  608.   end;
  609. end;
  610.  
  611. { This procedure is used to drive the mouse with the keyboard }
  612. procedure TMouseManager.MoveSmallJumpLeft;
  613. begin
  614.   { Use internal coordinates and check for screen wrapping }
  615.   if TheMX > KBMJ_SMALL then
  616.   begin
  617.     { Not wrapped; move along one unit to the left }
  618.     TheMX := TheMX - KBMJ_SMALL;
  619.     SetCursorPos( TheMX , TheMY );
  620.   end
  621.   else
  622.   begin
  623.     { Wrapped; jump to right and move back the unit }
  624.     TheMX := Screen.Width - KBMJ_SMALL;
  625.     SetCursorPos( TheMX , TheMY );
  626.   end;
  627. end;
  628.  
  629. { This procedure is used to drive the mouse with the keyboard }
  630. procedure TMouseManager.MoveSmallJumpRight;
  631. begin
  632.   { Use internal coordinates and check for screen wrapping }
  633.   if TheMX < ( Screen.Width - KBMJ_SMALL ) then
  634.   begin
  635.     { Not wrapped; move along one unit to the right }
  636.     TheMX := TheMX + KBMJ_SMALL;
  637.     SetCursorPos( TheMX , TheMY );
  638.   end
  639.   else
  640.   begin
  641.     { Wrapped; jump to left and move in one unit }
  642.     TheMX := KBMJ_SMALL;
  643.     SetCursorPos( TheMX , TheMY );
  644.   end;
  645. end;
  646.  
  647. { This procedure is used to drive the mouse with the keyboard }
  648. procedure TMouseManager.MoveSmallJumpUp;
  649. begin
  650.   { Use internal coordinates and check for screen wrapping }
  651.   if TheMY > KBMJ_SMALL then
  652.   begin
  653.     { Not wrapped; move along one unit to the top }
  654.     TheMY := TheMY - KBMJ_SMALL;
  655.     SetCursorPos( TheMX , TheMY );
  656.   end
  657.   else
  658.   begin
  659.     { Wrapped; jump to bottom and move back one unit }
  660.     TheMY := Screen.Height - KBMJ_SMALL;
  661.     SetCursorPos( TheMX , TheMY );
  662.   end;
  663. end;
  664.  
  665. { This procedure is used to drive the mouse with the keyboard }
  666. procedure TMouseManager.MoveSmallJumpDown;
  667. begin
  668.   { Use internal coordinates and check for screen wrapping }
  669.   if TheMY < ( Screen.Height - KBMJ_SMALL ) then
  670.   begin
  671.     { Not wrapped; move along one unit to the bottom }
  672.     TheMY := TheMY + KBMJ_SMALL;
  673.     SetCursorPos( TheMX , TheMY );
  674.   end
  675.   else
  676.   begin
  677.     { Wrapped; jump to top and move back one unit }
  678.     TheMY := KBMJ_SMALL;
  679.     SetCursorPos( TheMX , TheMY );
  680.   end;
  681. end;
  682.  
  683. { This procedure is used to drive the mouse with the keyboard }
  684. procedure TMouseManager.MoveLargeJumpLeft;
  685. begin
  686.   { Use internal coordinates and check for screen wrapping }
  687.   if TheMX > KBMJ_LARGE then
  688.   begin
  689.     { Not wrapped; move along the unit to the left }
  690.     TheMX := TheMX - KBMJ_LARGE;
  691.     SetCursorPos( TheMX , TheMY );
  692.   end
  693.   else
  694.   begin
  695.     { Wrapped; jump to right and move back the unit }
  696.     TheMX := Screen.Width - KBMJ_LARGE;
  697.     SetCursorPos( TheMX , TheMY );
  698.   end;
  699. end;
  700.  
  701. { This procedure is used to drive the mouse with the keyboard }
  702. procedure TMouseManager.MoveLargeJumpRight;
  703. begin
  704.   { Use internal coordinates and check for screen wrapping }
  705.   if TheMX < ( Screen.Width - KBMJ_LARGE ) then
  706.   begin
  707.     { Not wrapped; move along one unit to the right }
  708.     TheMX := TheMX + KBMJ_LARGE;
  709.     SetCursorPos( TheMX , TheMY );
  710.   end
  711.   else
  712.   begin
  713.     { Wrapped; jump to left and move in one unit }
  714.     TheMX := KBMJ_LARGE;
  715.     SetCursorPos( TheMX , TheMY );
  716.   end;
  717. end;
  718.  
  719. { This procedure is used to drive the mouse with the keyboard }
  720. procedure TMouseManager.MoveLargeJumpUp;
  721. begin
  722.   { Use internal coordinates and check for screen wrapping }
  723.   if TheMY > KBMJ_LARGE then
  724.   begin
  725.     { Not wrapped; move along one unit to the top }
  726.     TheMY := TheMY - KBMJ_LARGE;
  727.     SetCursorPos( TheMX , TheMY );
  728.   end
  729.   else
  730.   begin
  731.     { Wrapped; jump to bottom and move back one unit }
  732.     TheMY := Screen.Height - KBMJ_LARGE;
  733.     SetCursorPos( TheMX , TheMY );
  734.   end;
  735. end;
  736.  
  737. { This procedure is used to drive the mouse with the keyboard }
  738. procedure TMouseManager.MoveLargeJumpDown;
  739. begin
  740.   { Use internal coordinates and check for screen wrapping }
  741.   if TheMY < ( Screen.Height - KBMJ_LARGE ) then
  742.   begin
  743.     { Not wrapped; move along one unit to the bottom }
  744.     TheMY := TheMY + KBMJ_LARGE;
  745.     SetCursorPos( TheMX , TheMY );
  746.   end
  747.   else
  748.   begin
  749.     { Wrapped; jump to top and move back one unit }
  750.     TheMY := KBMJ_LARGE;
  751.     SetCursorPos( TheMX , TheMY );
  752.   end;
  753. end;
  754.  
  755. { This procedure sets up the bitmaps and global HDC prior to moving a }
  756. { Bitmap cursor.                                                      }
  757. procedure TMouseManager.StartBitmapCursor( TheX , TheY : Integer );
  758. var WorkingPoint1 ,
  759.     WorkingPoint2 : TPoint;
  760. begin
  761.   GlobalDC := GetDC( 0 );
  762.   WorkspaceBMP := TBitmap.Create;
  763.   WorkspaceBMP.Width := Screen.Width;
  764.   WorkSpaceBMP.Height := Screen.Height;
  765.   BitBlt( WorkspaceBMP.Canvas.Handle , 0 , 0 , Screen.Width , Screen.Height ,
  766.    GlobalDC , 0 , 0 , SrcCopy );
  767.   BackgroundBMP := TBitmap.Create;
  768.   BackgroundBMP.Width := CursorBMP.Width;
  769.   BackgroundBMP.Height := CursorBMP.Height;
  770.   New_X := TheX;
  771.   New_Y := TheY;
  772.   StoredCursor := Screen.Cursor;
  773.   Screen.Cursor := CR_NULL;
  774.   {Grab the background image}
  775.   WorkingPoint1.X := New_X - ( CursorBMP.Width div 2 );
  776.   WorkingPoint1.Y := New_Y - ( CursorBMP.Height div 2 );
  777.   WorkingPoint2.X := New_X + ( CursorBMP.Width - ( CursorBMP.Width div 2 ));
  778.   WorkingPoint2.Y := New_Y + ( CursorBMP.Height - ( CursorBMP.Height div 2 ));
  779.   BackgroundBmp.Canvas.CopyRect( Rect( 0 , 0 , CursorBMP.Width , CursorBMP.Height ) ,
  780.    WorkspaceBMP.Canvas , Rect( WorkingPoint1.X , WorkingPoint1.Y , WorkingPoint2.X ,
  781.     WorkingPoint2.Y ));
  782.   {Put the cursor bitmap onto the workspace canvas}
  783.   with WorkspaceBMP.Canvas do
  784.   begin
  785.     CopyMode := cmSrcCopy;
  786.     CopyRect( Rect( WorkingPoint1.X , WorkingPoint1.Y , WorkingPoint2.X , WorkingPoint2.Y ),
  787.      CursorBMP.Canvas , Rect( 0 , 0 , CursorBMP.Width , CursorBMP.Height ));
  788.   end;
  789.   {Copy the workspace bitmap onto the visible screen}
  790.     BitBlt( GlobalDC , WorkingPoint1.X , WorkingPoint1.Y , CursorBMP.Width , CursorBMP.Height ,
  791.      WorkspaceBMP.Canvas.Handle , WorkingPoint1.X , WorkingPoint1.Y , SrcCopy );
  792.   Old_X := New_X;
  793.   Old_Y := New_Y;
  794. end;
  795.  
  796. { This procedure moves a bitmap cursor according to the imported New coords }
  797. procedure TMouseManager.MoveBitmapCursor( TheX , TheY : Integer );
  798. var StartX,
  799.     StartY,
  800.     XDiff,
  801.     YDiff : Integer;
  802.     WorkingPoint1 ,
  803.     WorkingPoint2  : TPoint;
  804. begin
  805.   New_X := TheX;
  806.   New_Y := TheY;
  807.   WorkingPoint1.X := Old_X - ( CursorBMP.Width div 2 );
  808.   WorkingPoint1.Y := Old_Y - ( CursorBMP.Height div 2 );
  809.   WorkingPoint2.X := Old_X + ( CursorBMP.Width - ( CursorBMP.Width div 2 ));
  810.   WorkingPoint2.Y := Old_Y + ( CursorBMP.Height - ( CursorBMP.Height div 2 ));
  811.   with WorkspaceBMP.Canvas do
  812.   begin
  813.     CopyMode := cmSrcCopy;
  814.     CopyRect( Rect( WorkingPoint1.X , WorkingPoint1.Y , WorkingPoint2.X , WorkingPoint2.Y ),
  815.       BackgroundBMP.Canvas , Rect( 0 , 0 , CursorBMP.Width , CursorBMP.Height ));
  816.   end;
  817.   {Put the saved bitmap onto the workspace canvas}
  818.   with WorkspaceBMP.Canvas do
  819.   begin
  820.     CopyMode := cmSrcCopy;
  821.     CopyRect( Rect( WorkingPoint1.X , WorkingPoint1.Y , WorkingPoint2.X , WorkingPoint2.Y ),
  822.      BackgroundBMP.Canvas , Rect( 0 , 0 , CursorBMP.Width , CursorBMP.Height ));
  823.   end;
  824.   {Grab the background image}
  825.   WorkingPoint1.X := New_X - ( CursorBMP.Width div 2 );
  826.   WorkingPoint1.Y := New_Y - ( CursorBMP.Height div 2 );
  827.   WorkingPoint2.X := New_X + ( CursorBMP.Width - ( CursorBMP.Width div 2 ));
  828.   WorkingPoint2.Y := New_Y + ( CursorBMP.Height - ( CursorBMP.Height div 2 ));
  829.   BackgroundBmp.Canvas.CopyRect( Rect( 0 , 0 , CursorBMP.Width , CursorBMP.Height ) ,
  830.    WorkspaceBMP.Canvas , Rect( WorkingPoint1.X , WorkingPoint1.Y , WorkingPoint2.X ,
  831.     WorkingPoint2.Y ));
  832.   {Put the cursor bitmap onto the workspace canvas}
  833.   with WorkspaceBMP.Canvas do
  834.   begin
  835.     CopyMode := cmSrcCopy;
  836.     CopyRect( Rect( WorkingPoint1.X , WorkingPoint1.Y , WorkingPoint2.X , WorkingPoint2.Y ),
  837.      CursorBMP.Canvas , Rect( 0 , 0 , CursorBMP.Width , CursorBMP.Height ));
  838.   end;
  839.   {Copy the workspace bitmap onto the visible screen}
  840.   if New_X > Old_X then StartX := Old_X else StartX := New_X;
  841.   if New_Y > Old_Y then StartY := Old_Y else StartY := New_Y;
  842.   XDiff := Abs( Old_X - New_X );
  843.   YDiff := Abs( Old_Y - New_Y );
  844.   {Grab the background image}
  845.   WorkingPoint1.X := StartX - ( CursorBMP.Width div 2 );
  846.   WorkingPoint1.Y := StartY - ( CursorBMP.Height div 2 );
  847.   BitBlt( GlobalDC , WorkingPoint1.X , WorkingPoint1.Y , CursorBMP.Width + XDiff ,
  848.    CursorBMP.Height + YDiff , WorkspaceBMP.Canvas.Handle , WorkingPoint1.X ,
  849.     WorkingPoint1.Y , SrcCopy );
  850.   Old_X := New_X;
  851.   Old_Y := New_Y;
  852. end;
  853.  
  854. { This procedure releases a bitmap cursor and frees its DC }
  855. procedure TMouseManager.EndBitmapCursor( TheX , TheY : Integer );
  856. var WorkingPoint1 ,
  857.     WorkingPoint2 : TPoint;
  858. begin
  859.   BitmapCursor := false;
  860.   WorkingPoint1.X := Old_X - ( CursorBMP.Width div 2 );
  861.   WorkingPoint1.Y := Old_Y - ( CursorBMP.Height Div 2 );
  862.   WorkingPoint2.X := Old_X + ( CursorBMP.Width - ( CursorBMP.Width div 2 ));
  863.   WorkingPoint2.Y := Old_Y + ( CursorBMP.Height - ( CursorBMP.Height div 2 ));
  864.   {Put the saved bitmap onto the workspace canvas}
  865.   with WorkspaceBMP.Canvas do
  866.   begin
  867.     CopyMode := cmSrcCopy;
  868.     CopyRect( Rect( WorkingPoint1.X , WorkingPoint1.Y , WorkingPoint2.X , WorkingPoint2.Y ),
  869.        BackGroundBMP.Canvas , Rect( 0 , 0 , CursorBMP.Width ,  CursorBMP.Height ));
  870.   end;
  871.   {Copy the workspace bitmap onto the visible screen}
  872.   BitBlt( GlobalDC , WorkingPoint1.X , WorkingPoint1.Y , CursorBMP.Width , CursorBMP.Height ,
  873.    WorkspaceBMP.Canvas.handle , WorkingPoint1.X , WorkingPoint1.Y , SrcCopy );
  874.   ReleaseDC( 0 , GlobalDC );
  875.   Screen.Cursor := StoredCursor;
  876. end;
  877.  
  878. { This procedure starts the process of displaying an icon cursor }
  879. procedure TMouseManager.StartIconCursor( TheX , TheY : Integer );
  880. var WorkingPoint1 ,
  881.     WorkingPoint2 : TPoint;
  882. begin
  883.   GlobalDC := GetDC( 0 );
  884.   WorkspaceBMP := TBitmap.Create;
  885.   WorkspaceBMP.Width := Screen.Width;
  886.   WorkSpaceBMP.Height := Screen.Height;
  887.   BitBlt( WorkspaceBMP.Canvas.Handle , 0 , 0 , Screen.Width , Screen.Height ,
  888.    GlobalDC , 0 , 0 , SrcCopy );
  889.   BackgroundBMP := TBitmap.Create;
  890.   BackgroundBMP.Width := 33;
  891.   BackgroundBMP.Height := 33;
  892.   New_X := TheX;
  893.   New_Y := TheY;
  894.   StoredCursor := Screen.Cursor;
  895.   Screen.Cursor := CR_NULL;
  896.   {Grab the background image}
  897.   WorkingPoint1.X := New_X - 16;
  898.   WorkingPoint1.Y := New_Y - 16;
  899.   WorkingPoint2.X := New_X + 17;
  900.   WorkingPoint2.Y := New_Y + 17;
  901.   BackgroundBmp.Canvas.CopyRect( Rect( 0 , 0 , 33 , 33 ) , WorkspaceBMP.Canvas ,
  902.      Rect( WorkingPoint1.X , WorkingPoint1.Y , WorkingPoint2.X , WorkingPoint2.Y ));
  903.   {Put the icon onto the workspace canvas}
  904.   with WorkspaceBMP.Canvas do
  905.   begin
  906.     Draw( WorkingPoint1.X , WorkingPoint1.Y , CursorIcon );
  907.   end;
  908.   {Copy the workspace bitmap onto the visible screen}
  909.     BitBlt( GlobalDC , WorkingPoint1.X , WorkingPoint1.Y , 33 , 33 ,
  910.      WorkspaceBMP.Canvas.Handle , WorkingPoint1.X , WorkingPoint1.Y , SrcCopy );
  911.   Old_X := New_X;
  912.   Old_Y := New_Y;
  913. end;
  914.  
  915. { This procedure moves the icon cursor in response to mouse moves }
  916. procedure TMouseManager.MoveIconCursor( TheX , TheY : Integer );
  917. var StartX,
  918.     StartY,
  919.     XDiff,
  920.     YDiff : Integer;
  921.     WorkingPoint1 ,
  922.     WorkingPoint2  : TPoint;
  923. begin
  924.   New_X := TheX;
  925.   New_Y := TheY;
  926.   {Put the saved bitmap onto the workspace canvas}
  927.   WorkingPoint1.X := Old_X - 16;
  928.   WorkingPoint1.Y := Old_Y - 16;
  929.   WorkingPoint2.X := Old_X + 17;
  930.   WorkingPoint2.Y := Old_Y + 17;
  931.   with WorkspaceBMP.Canvas do
  932.   begin
  933.     CopyMode := cmSrcCopy;
  934.     CopyRect( Rect( WorkingPoint1.X , WorkingPoint1.Y , WorkingPoint2.X , WorkingPoint2.Y ),
  935.       BackgroundBMP.Canvas , Rect( 0 , 0 , 33 , 33 ));
  936.   end;
  937.   {Grab the background image}
  938.   WorkingPoint1.X := New_X - 16;
  939.   WorkingPoint1.Y := New_Y - 16;
  940.   WorkingPoint2.X := New_X + 17;
  941.   WorkingPoint2.Y := New_Y + 17;
  942.   BackgroundBMP.Canvas.CopyRect( Rect( 0 , 0 , 33 , 33 ) , WorkspaceBMP.Canvas ,
  943.      Rect( WorkingPoint1.X , WorkingPoint1.Y , WorkingPoint2.X , WorkingPoint2.Y ));
  944.   {Put the icon onto the workspace canvas}
  945.   with WorkspaceBMP.Canvas do
  946.   begin
  947.     Draw( WorkingPoint1.X , WorkingPoint1.Y , CursorIcon );
  948.   end;
  949.   {Copy the workspace bitmap onto the visible screen}
  950.     if New_X > Old_X then StartX := Old_X else StartX := New_X;
  951.     if New_Y > Old_Y then StartY := Old_Y else StartY := New_Y;
  952.     XDiff := Abs( Old_X - New_X );
  953.     YDiff := Abs( Old_Y - New_Y );
  954.     {Grab the background image}
  955.     WorkingPoint1.X := StartX - 16;
  956.     WorkingPoint1.Y := StartY - 16;
  957.     BitBlt( GlobalDC , WorkingPoint1.X , WorkingPoint1.Y , 33 + XDiff , 33 + YDiff ,
  958.      WorkspaceBMP.Canvas.Handle , WorkingPoint1.X , WorkingPoint1.Y , SrcCopy );
  959.   Old_X := New_X;
  960.   Old_Y := New_Y;
  961. end;
  962.  
  963. { This procedure ends the icon cursor movement and frees its DCs }
  964. procedure TMouseManager.EndIconCursor( TheX , TheY : Integer );
  965. var WorkingPoint1 ,
  966.     WorkingPoint2 : TPoint;
  967. begin
  968.   IconCursor := false;
  969.   WorkingPoint1.X := Old_X - 16;
  970.   WorkingPoint1.Y := Old_Y - 16;
  971.   WorkingPoint2.X := Old_X + 17;
  972.   WorkingPoint2.Y := Old_Y + 17;
  973.   {Put the saved bitmap onto the workspace canvas}
  974.   with WorkspaceBMP.Canvas do
  975.   begin
  976.     CopyMode := cmSrcCopy;
  977.     CopyRect( Rect( WorkingPoint1.X , WorkingPoint1.Y , WorkingPoint2.X , WorkingPoint2.Y ),
  978.        BackGroundBMP.Canvas , Rect( 0 , 0 , 33 ,  33 ));
  979.   end;
  980.   {Copy the workspace bitmap onto the visible screen}
  981.   BitBlt( GlobalDC , WorkingPoint1.X , WorkingPoint1.Y , 33 , 33 ,
  982.    WorkspaceBMP.Canvas.handle , WorkingPoint1.X , WorkingPoint1.Y , SrcCopy );
  983.   ReleaseDC( 0 , GlobalDC );
  984.   Screen.Cursor := StoredCursor;
  985. end;
  986.  
  987. { This procedure starts the animated icon cursor }
  988. procedure TMouseManager.StartAnimatedIconCursor( TheX , TheY : Integer );
  989. begin
  990.   StartIconCursor( TheX , TheY );
  991.   TheTimer.Enabled := true;
  992.   CurrentAnimationPointer := 1;
  993. end;
  994.  
  995. { This procedue ends the animated icon cursor }
  996. procedure TMouseManager.EndAnimatedIconCursor( TheX , TheY : Integer );
  997. begin
  998.   EndIconCursor( TheX , TheY );
  999.   TheTimer.Enabled := false;
  1000.   CursorIcon := TIcon( TheAnimationList[ 0 ] );
  1001. end;
  1002.  
  1003. { This procedure moves the animated icon cursor }
  1004. procedure TMouseManager.MoveAnimatedIconCursor( TheX , TheY : Integer );
  1005. begin
  1006.   MoveIconCursor( TheX , TheY );
  1007. end;
  1008.  
  1009. { This procedure switches icons on timer events and prompts a redraw }
  1010. procedure TMouseManager.TimerAction( Sender : TObject );
  1011. begin
  1012.   Inc( CurrentAnimationPointer );     
  1013.   if CurrentAnimationPointer > TheAnimationList.Count then
  1014.    CurrentAnimationPointer := 1;
  1015.   CursorIcon := TIcon( TheAnimationList[ CurrentAnimationPointer - 1 ] );
  1016.   MoveIconCursor( Old_X , Old_Y );
  1017. end;
  1018.  
  1019. { This function returns true if CAPSLOCK is down }
  1020. function TIoManager.IsCapsLockDown : Boolean;
  1021. begin
  1022.   if CLState then result := true else result := false;
  1023. end;
  1024.  
  1025. { This function returns true if NUMLOCK is down }
  1026. function TIoManager.ISNumLockDown : Boolean;
  1027. begin
  1028.   if NLState then result := true else result := false;
  1029. end;
  1030.  
  1031. { This function returns true if SCROLLLOCK is down }
  1032. function TIoManager.IsScrollLockDown : Boolean;
  1033. begin
  1034.   if SLState then result := true else result := false;
  1035. end;
  1036.  
  1037. { this function gets the values for CLState, NLState, and SLState }
  1038. procedure TIoManager.InitLocks;
  1039. var TheKeys : TKeyboardState;
  1040. begin
  1041.   GetKeyBoardState( TheKeys );
  1042.   CLState := (( TheKeys[ VK_Capital ] mod 2 ) = 1 );
  1043.   NLState := (( TheKeys[ VK_Numlock ] mod 2 ) = 1 );
  1044.   CLState := (( TheKeys[ VK_Scroll ] mod 2 ) = 1 );
  1045. end;
  1046.  
  1047. { This procedure returns the state of the three lock variables }
  1048. procedure TIoManager.ReadLocks( var TheCL , TheNL , TheSL : Boolean );
  1049. begin
  1050.   TheCL := CLState;
  1051.   TheNL := NLState;
  1052.   TheSL := SLState;
  1053. end;
  1054.  
  1055. { This procedure sets the state of the three lock variables to the imported vals }
  1056. procedure TIoManager.SetLocks( TheCL , TheNL , TheSL : Boolean );
  1057. var TheKeys : TKeyBoardState;
  1058. begin
  1059.   GetKeyBoardState( TheKeys );
  1060.   CLState := TheCL;
  1061.   NLState := TheNL;
  1062.   SLState := TheSL;
  1063.   if ClState then TheKeys[ VK_Capital ] := 1 else
  1064.    TheKeys[ VK_Capital ] := 0;
  1065.   if NLState then TheKeys[ VK_Numlock ] := 1 else
  1066.    TheKeys[ VK_Numlock ] := 0;
  1067.   if SLState then TheKeys[ VK_Scroll ] := 1 else
  1068.    TheKeys[ VK_Scroll ] := 0;
  1069.   SetKeyBoardState( TheKeys );
  1070. end;
  1071.  
  1072. { This procedure handles pressing of F1 for CCFileManagerForm }
  1073. procedure TIoManager.OnF1Pressed(Sender: TObject; var Key: Word;
  1074.   Shift: TShiftState);
  1075. begin
  1076.   MessageDlg( 'Help not implemented!' , mtInformation,[mbok],0);
  1077. end;
  1078.  
  1079. { This procedure handles pressing of F2 for CCFileManagerForm }
  1080. procedure TIoManager.OnF2Pressed(Sender: TObject; var Key: Word;
  1081.   Shift: TShiftState);
  1082. begin
  1083.   TCCFileMgrForm( Parent ).BitBtn1Click( Sender );
  1084. end;
  1085.  
  1086. { This procedure handles pressing of F3 for CCFileManagerForm }
  1087. procedure TIoManager.OnF3Pressed(Sender: TObject; var Key: Word;
  1088.   Shift: TShiftState);
  1089. begin
  1090.   TCCFileMgrForm( Parent ).BitBtn2Click( Sender );
  1091. end;
  1092.  
  1093. { This procedure handles pressing of F4 for CCFileManagerForm }
  1094. procedure TIoManager.OnF4Pressed(Sender: TObject; var Key: Word;
  1095.   Shift: TShiftState);
  1096. begin
  1097.   TCCFileMgrForm( Parent ).BitBtn3Click( Sender );
  1098. end;
  1099.  
  1100. { This procedure handles pressing of F5 for CCFileManagerForm }
  1101. procedure TIoManager.OnF5Pressed(Sender: TObject; var Key: Word;
  1102.   Shift: TShiftState);
  1103. begin
  1104.   TCCFileMgrForm( Parent ).BitBtn4Click( Sender );
  1105. end;
  1106.  
  1107. { This procedure handles pressing of F6 for CCFileManagerForm }
  1108. procedure TIoManager.OnF6Pressed(Sender: TObject; var Key: Word;
  1109.   Shift: TShiftState);
  1110. begin
  1111.   TCCFileMgrForm( Parent ).BitBtn5Click( Sender );
  1112. end;
  1113.  
  1114. { This procedure handles pressing of F7 for CCFileManagerForm }
  1115. procedure TIoManager.OnF7Pressed(Sender: TObject; var Key: Word;
  1116.   Shift: TShiftState);
  1117. begin
  1118.   TCCFileMgrForm( Parent ).BitBtn9Click( Sender );
  1119. end;
  1120.  
  1121. { This procedure handles pressing of F8 for CCFileManagerForm }
  1122. procedure TIoManager.OnF8Pressed(Sender: TObject; var Key: Word;
  1123.   Shift: TShiftState);
  1124. begin
  1125.   TCCFileMgrForm( Parent ).BitBtn6Click( Sender );
  1126. end;
  1127.  
  1128. { This procedure handles pressing of F9 for CCFileManagerForm }
  1129. procedure TIoManager.OnF9Pressed(Sender: TObject; var Key: Word;
  1130.   Shift: TShiftState);
  1131. begin
  1132.   TCCFileMgrForm( Parent ).Update;
  1133. end;
  1134.  
  1135. { This procedure handles pressing of F10 for CCFileManagerForm }
  1136. procedure TIoManager.OnF10Pressed(Sender: TObject; var Key: Word;
  1137.   Shift: TShiftState);
  1138. begin
  1139.   TCCFileMgrForm( Parent ).BitBtn7Click( Sender );
  1140. end;
  1141.  
  1142. { This procedure handles pressing of F11 for CCFileManagerForm }
  1143. procedure TIoManager.OnF11Pressed(Sender: TObject; var Key: Word;
  1144.   Shift: TShiftState);
  1145. begin
  1146.   TCCFileMgrForm( Parent ).BitBtn8Click( Sender );
  1147. end;
  1148.  
  1149. { This procedure handles pressing of F12 for CCFileManagerForm }
  1150. procedure TIoManager.OnF12Pressed(Sender: TObject; var Key: Word;
  1151.   Shift: TShiftState);
  1152. begin
  1153.   TCCFileMgrForm( Parent ).BitBtn10Click( Sender );
  1154. end;
  1155.  
  1156. { Returns True if the Left Button was pressed in the last mouse operation }
  1157. function TIOManager.WasLeftPressed : Boolean;
  1158. begin
  1159.   if ( mbLeft = WhichButton ) then WasLeftPressed := true else
  1160.    WasLeftPressed := false;
  1161. end;
  1162.  
  1163. { Returns true if the Right Button was pressed in the last mouse operation }
  1164. function TIOManager.WasRightPressed : Boolean;
  1165. begin
  1166.   if mbRight = WhichButton then WasRightPressed := true else
  1167.    WasRightPressed := false;
  1168. end;
  1169.  
  1170. { Returns true if the Middle Button was pressed in the last mouse operation }
  1171. function TIOManager.WasMiddlePressed : Boolean;
  1172. begin
  1173.   if mbMiddle = WhichButton then WasMiddlePressed := true else
  1174.    WasMiddlePressed := false;
  1175. end;
  1176.  
  1177. { Returns true if the ALT key was down during the last IO operation }
  1178. function TIOManager.WasALTPressed : Boolean;
  1179. begin
  1180.   if ssAlt in WhichState then WasALTPressed := true else
  1181.    WasALTPressed := false;
  1182. end;
  1183.  
  1184. { Returns true if either SHIFT key was down during the last IO operation }
  1185. function TIOManager.WasSHIFTPressed : Boolean;
  1186. begin
  1187.   if ssShift in WhichState then WasSHIFTPressed := true else
  1188.    WasSHIFTPressed := false;
  1189. end;
  1190.  
  1191. { Returns true if the Control Key was down during the last IO operation }
  1192. function TIOManager.WasCTRLPressed : Boolean;
  1193. begin
  1194.   if ssCtrl in WhichState then WasCTRLPressed := true else
  1195.    WasCTRLPressed := false;
  1196. end;
  1197.  
  1198.  
  1199. { This procedure does a fully error-trapped change directory }
  1200. procedure TFileWorkBench.ChangeTheDirectory( NewPath : String );
  1201. var CurrentDirectory : String;
  1202. begin
  1203.   if NewPath = '..' then
  1204.   begin { Back up one level }
  1205.     {$I+}
  1206.     try
  1207.       { Find the current directory }
  1208.       GetDir( 0 , CurrentDirectory );
  1209.       { Use EFP to move up one level }
  1210.       CurrentDirectory := ExtractFilePath( CurrentDirectory );
  1211.       { Strip trailing \ if not root }
  1212.       CurrentDirectory := StripNonRootTrailingBackSlash( CurrentDirectory );
  1213.       { Try the change to the New drive }
  1214.       ChDir( CurrentDirectory );
  1215.     except
  1216.       { if any exception occurs instantiate exception and show }
  1217.       On E:EInOutError do
  1218.       begin
  1219.         { Call custom error display/lookup procedure }
  1220.         HandleIOException( EOC_CHANGEDIR , CurrentDirectory ,
  1221.          E.Message , E.ErrorCode );
  1222.       end;
  1223.     end;
  1224.   end
  1225.   else
  1226.   begin { Change to explicit path }
  1227.     {$I+}
  1228.     try
  1229.       { Get target directory path }
  1230.       CurrentDirectory := NewPath;
  1231.       { Strip trailing \ if not root }
  1232.       CurrentDirectory := StripNonRootTrailingBackSlash( CurrentDirectory );
  1233.       { Try the change to the New drive }
  1234.       ChDir( CurrentDirectory );
  1235.     except
  1236.       { if any exception occurs instantiate exception and show }
  1237.       On E:EInOutError do
  1238.       begin
  1239.         { Call custom error display/lookup procedure }
  1240.         HandleIOException( EOC_CHANGEDIR , CurrentDirectory ,
  1241.          E.Message , E.ErrorCode );
  1242.       end;
  1243.     end;
  1244.   end;
  1245. end;
  1246.  
  1247. { This procedure does a fully error-trapped change directory }
  1248. procedure TFileWorkBench.ChangeTheDriveAndDirectory( NewDrive : Integer );
  1249. var CurrentDirectory : String;
  1250. begin
  1251.   {$I+}
  1252.   try
  1253.     { Find the working directory on New drive }
  1254.     GetDir( NewDrive , CurrentDirectory );
  1255.     { Try the change to the New drive }
  1256.     ChDir( CurrentDirectory );
  1257.   except
  1258.     { if any exception occurs instantiate exception and show }
  1259.     On E:EInOutError do
  1260.     begin
  1261.       { Call custom error display/lookup procedure }
  1262.       HandleIOException( EOC_CHANGEDIR , CurrentDirectory ,
  1263.        E.Message , E.ErrorCode );
  1264.     end;
  1265.   end;
  1266. end;
  1267.  
  1268. { This procedure copies a single file with error trapping }
  1269. procedure TFileWorkBench.CopyTheFile( OldPath , NewPath : String );
  1270. var AResult : Boolean; { Internal data flag }
  1271. begin
  1272.   { If Copyfile returns false an error occurred }
  1273.   AResult := CopyFile( OldPath , NewPath +
  1274.    ExtractFileName( OldPath ));
  1275.   { Display meaningful error message }
  1276.   if not AResult then HandleDOSError( GlobalErrorType , OldPath, GlobalError );
  1277. end;
  1278.  
  1279. { This procedure moves a file by copying and delete it }
  1280. procedure TFileWorkBench.MoveTheFile( OldPath , NewPath : String );
  1281. var AResult : Boolean; { Internal data flag }
  1282.     TheFile : File;    { Use to get errors  }
  1283. begin
  1284.   { If Copyfile returns false an error occurred }
  1285.   AResult := CopyFile( OldPath , NewPath +
  1286.     ExtractFileName( OldPath ));
  1287.   { Display meaningful error message }
  1288.   if not AResult then HandleDOSError( GlobalErrorType ,
  1289.     OldPath , GlobalError );
  1290.   { After valid copying, delete source file }
  1291.   {$I+}
  1292.   if AResult then try
  1293.     { Use this trick to get valid exception handling }
  1294.     AssignFile( TheFile , OldPath );
  1295.     { Use erase because Deletefile doesn't give exceptions! }
  1296.     Erase( TheFile );
  1297.   except
  1298.     { if any exception occurs instantiate exception and show }
  1299.     On E:EInOutError do
  1300.     begin
  1301.       { Call custom error display/lookup procedure }
  1302.       HandleIOException( EOC_DELETEFILE , OldPath ,
  1303.        E.Message , E.ErrorCode );
  1304.     end;
  1305.   end;
  1306. end;
  1307.  
  1308. { This procedure safely deletes a single file }
  1309. procedure TFileWorkBench.DeleteTheFile( ThePath : String );
  1310. var TheFile : File; { Internal file handle }
  1311. begin
  1312.   {$I+}
  1313.   try
  1314.     { Use this trick to get valid exception handling }
  1315.     AssignFile( TheFile , ThePath );
  1316.     { Use erase because Deletefile doesn't give exceptions! }
  1317.     Erase( TheFile );
  1318.   except
  1319.     { if any exception occurs instantiate exception and show }
  1320.     On E:EInOutError do
  1321.     begin
  1322.       { Call custom error display/lookup procedure }
  1323.       HandleIOException( EOC_DELETEFILE , ThePath ,
  1324.        E.Message , E.ErrorCode );
  1325.     end;
  1326.   end;
  1327. end;
  1328.  
  1329. { This procedure renames a file with full error trapping }
  1330. procedure TFileWorkBench.RenameTheFile( OldPath , NewName : String );
  1331. var TheFile : File; { Internal file handle }
  1332. begin
  1333.   {$I+}
  1334.   try
  1335.     { Use this trick to get valid exception handling }
  1336.     AssignFile( TheFile , OldPath );
  1337.     { Use this because RenameFile doesn't give exceptions! }
  1338.     Rename( TheFile , NewName );
  1339.   except
  1340.     { if any exception occurs instantiate exception and show }
  1341.     On E:EInOutError do
  1342.     begin
  1343.       { Call custom error display/lookup procedure }
  1344.       HandleIOException( EOC_RENAMEFILE , OldPath  ,
  1345.        E.Message , E.ErrorCode );
  1346.     end;
  1347.   end;
  1348. end;
  1349.  
  1350. { This procedure creates a New directory with full error trapping }
  1351. procedure TFileWorkBench.CreateNewDirectory( NewPath : String );
  1352. begin
  1353.   {$I+}
  1354.   try
  1355.     Mkdir( NewPath );
  1356.   except
  1357.     { if any exception occurs instantiate exception and show }
  1358.     On E:EInOutError do
  1359.     begin
  1360.       { Call custom error display/lookup procedure }
  1361.       HandleIOException( EOC_MAKEDIR , NewPath  ,
  1362.        E.Message , E.ErrorCode );
  1363.     end;
  1364.   end;
  1365. end;
  1366.  
  1367. { This procedure remove a directory with full error trapping }
  1368. procedure TFileWorkBench.RemoveDirectory( ThePath : String );
  1369. begin
  1370.   {$I+}
  1371.   try
  1372.     Rmdir( ThePath );
  1373.   except
  1374.     { if any exception occurs instantiate exception and show }
  1375.     On E:EInOutError do
  1376.     begin
  1377.       { Call custom error display/lookup procedure }
  1378.       HandleIOException( EOC_DELETEDIR , ThePath  ,
  1379.        E.Message , E.ErrorCode );
  1380.     end;
  1381.   end;
  1382. end;
  1383.  
  1384. { Use this to set the attributes of a file with error trapping }
  1385. procedure TFileWorkBench.SetFileAttributes( TheFile  : String;
  1386.            TheAttributes : Integer );
  1387. var TheResult : Integer; { Holds error code if any }
  1388. begin
  1389.   { Attempt to set the attributes }
  1390.   TheResult := FileSetAttr( TheFile , TheAttributes );
  1391.   { if negative number error, so signal }
  1392.   if TheResult < 0 then
  1393.    HandleDOSError( EOC_SETATTR , TheFile , -TheResult );
  1394. end;
  1395.  
  1396. { This procedure recursively copies a directory to a New path }
  1397. procedure TFileWorkBench.RecursivelyCopyDirectory( OldPath , NewPath : String );
  1398. var TheDir : String; { Holds source directory }
  1399. begin
  1400.   { Get the source directory to copy }
  1401.   TheDir := ExtractFileName( OldPath );
  1402.   { Force a backslash to the Newpath variable }
  1403.   NewPath := ForceTrailingBackSlash( NewPath );
  1404.   { Add the source directory to the target path }
  1405.   NewPath := NewPath + TheDir;
  1406.   { Create a New directory with the New name }
  1407.   CreateNewDirectory( NewPath );
  1408.   { Force a backslash for compatibility }
  1409.   NewPath := FOrcetrailingBackSlash( NewPath );
  1410.   { Do the recursive call }
  1411.   HandleRecursiveAction( OldPath , NewPath , FAC_COPY );
  1412. end;
  1413.  
  1414. { This procedure recursively moves a directory tree }
  1415. procedure TFileWorkBench.RecursivelyMoveDirectory( OldPath , NewPath : String );
  1416. var TheDir    : String; { Holds source directory  }
  1417.     SavedPath : String; { Holds saved dir to kill }
  1418. begin
  1419.   { Get the source directory to move }
  1420.   TheDir := ExtractFileName( OldPath );
  1421.   { Force a backslash to the Newpath variable }
  1422.   NewPath := ForceTrailingBackSlash( NewPath );
  1423.   { Save the starting path just in case }
  1424.   SavedPath := OldPath;
  1425.   { Add the source directory to the target path }
  1426.   NewPath := NewPath + TheDir;
  1427.   { Create a New directory with the New name }
  1428.   CreateNewDirectory( NewPath );
  1429.   { Force a backslash for compatibility }
  1430.   NewPath := FOrcetrailingBackSlash( NewPath );
  1431.   { Do the recursive call }
  1432.   HandleRecursiveAction( OldPath , NewPath , FAC_MOVE );
  1433.   { Remove the source directory }
  1434.   RemoveDirectory( SavedPath );
  1435. end;
  1436.  
  1437. { This procedure handles recursively deleting an entire directory tree }
  1438. procedure TFileWorkBench.RecursivelyDeleteDirectory( ThePath : String );
  1439. begin
  1440.   HandleRecursiveAction( ThePath , '' , FAC_DELETE );
  1441. end;
  1442.  
  1443.  
  1444. { This is the generic routine to copy, move, and delete whole directory trees }
  1445. procedure TFileWorkBench.HandleRecursiveAction( StartingPath , NewPath : String;
  1446.            ActionCode : Integer );
  1447. { VITAL!!! These variables MUST be local for recursrion to work! }
  1448. var
  1449.     Finished        : Boolean;         { Loop flag              }
  1450.     TheSR           : TSearchRec;      { Searchrecord for FF/FN }
  1451.     TheResult       : Integer;         { return variable        }
  1452.     TargetPath ,
  1453.     FileMask   ,
  1454.     TheWorkingDirectory ,
  1455.     TheStoredWorkingDirectory ,
  1456.     ModifiedDirectory  : String;       { path for FF/FN         }
  1457.     TheFIP          : TFileIconPanel;  { generic FIP holder     }
  1458.     ButtonColor   ,                    { main panel color       }
  1459.     ButtonHLColor ,                    { bright panel color     }
  1460.     ButtonSColor  ,                    { dark panel color       }
  1461.     Textcolor       : TColor;          { label text color       }
  1462.     TheFile         : File;
  1463.  
  1464. begin
  1465.   { Set up the initial variables }
  1466.   Finished := false;
  1467.   TheWorkingDirectory := StartingPath;
  1468.   TheStoredWorkingDirectory := TheWorkingDirectory;
  1469.   TheWorkingDirectory := TheWorkingDirectory + '\*.*';
  1470.   TargetPath := ExtractFilePath( TheWorkingDirectory );
  1471.   { Make the call to FindFirst set to get any file }
  1472.   TheResult := FindFirst( TheWorkingDirectory , faAnyFile , TheSR );
  1473.   { loop through all files in the directory and delete them }
  1474.   while not Finished do
  1475.   begin
  1476.     { Make call to FindNext, using only SearchRecord from FindFirst }
  1477.     TheResult := FindNext( TheSR );
  1478.     { A -1 result means no more files so exit }
  1479.     if TheResult < 0 then finished := true else
  1480.     begin
  1481.       if (( FileGetAttr( TargetPath + TheSR.Name ) and faDirectory )
  1482.        <> faDirectory ) then
  1483.       begin { A File }
  1484.         case ActionCode of
  1485.           FAC_COPY :
  1486.               begin
  1487.                 CopyTheFile( TargetPath + TheSR.Name , NewPath );
  1488.               end;
  1489.           FAC_MOVE :
  1490.               begin
  1491.                 MoveTheFile( TargetPath + TheSR.Name , NewPath );
  1492.               end;
  1493.           FAC_DELETE :
  1494.               begin { Delete }
  1495.                 if MessageDlg( 'Delete file ' + TargetPath + TheSR.Name + '?',
  1496.                    mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  1497.                     DeleteTheFile( TargetPath + TheSR.Name );
  1498.               end;
  1499.         end;
  1500.       end;
  1501.     end;
  1502.   end;
  1503.   { Call FindClose for Windows NT/Windows 95 compatibility }
  1504.   FindClose( TheSR );
  1505.   { Set up the variables to do recursive calls on all directories}
  1506.   Finished := false;
  1507.   ModifiedDirectory := TheStoredWorkingdirectory + '\*.*';
  1508.   { Make the call to FindFirst set to get any file, ignore result }
  1509.   TheResult := FindFirst( ModifiedDirectory , faDirectory , TheSR );
  1510.   while not Finished do
  1511.   begin
  1512.     { Make call to FindNext, using only SearchRecord from FindFirst }
  1513.     TheResult := FindNext( TheSR );
  1514.     { A -1 result means no more files so exit }
  1515.     if TheResult < 0 then
  1516.       finished := true
  1517.     else
  1518.     begin
  1519.       if TheSR.Name <> '..' then { Ignore backup in this case }
  1520.       begin
  1521.         if (( FileGetAttr( TargetPath + TheSR.Name ) and faDirectory )
  1522.          = faDirectory ) then
  1523.         begin
  1524.           { Send in the New directory name }
  1525.           ModifiedDirectory := TheStoredWorkingDirectory  + '\' +
  1526.            TheSR.Name;
  1527.           { Reproduce directory structure for recursion in copy/move }
  1528.           NewPath := NewPath + TheSR.Name;
  1529.           case ActionCode of
  1530.             FAC_COPY , FAC_MOVE :
  1531.                begin { Create ahead for move and copy }
  1532.                  { Make the New directory for moving and copying }
  1533.                  CreateNewDirectory( NewPath );
  1534.                  { Force a backslash for compatibility }
  1535.                  NewPath := ForceTrailingBackSlash( NewPath );
  1536.                end;
  1537.             FAC_DELETE :
  1538.                begin  { No prior action needed for Delete }
  1539.                end;
  1540.           end;
  1541.           { Do the recursive call }
  1542.           HandleRecursiveAction( ModifiedDirectory , NewPath , ActionCode );
  1543.           case ActionCode of
  1544.             FAC_COPY :
  1545.                begin { no action for copy }
  1546.                end;
  1547.             FAC_MOVE , FAC_DELETE :
  1548.                begin  { Delete }
  1549.                  { Get a confirmation }
  1550.                  if MessageDlg( 'Remove Directory ' + TargetPath + TheSR.Name
  1551.                   + '?', mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  1552.                    RemoveDirectory( TargetPath + TheSR.Name );
  1553.                end;
  1554.           end;
  1555.         end;
  1556.       end;
  1557.     end;
  1558.   end;
  1559. end;
  1560.  
  1561. { This is a generic copy routine taken from Delphi sample code }
  1562. { This function calls the sample Copy code and handles errors }
  1563. function TFileWorkBench.CopyFile( TargetPath ,
  1564.           DestinationPath : String ) : Boolean;
  1565. begin
  1566.   { Set global error value to no error }
  1567.   GlobalError := 0;
  1568.   { Call the sample procedure to do the copy }
  1569.   FMXUCopyFile( TargetPath, DestinationPath , GlobalErrorType , GlobalError );
  1570.   { If no error return true else return false }
  1571.   if GlobalError < 0 then CopyFile := false else
  1572.    CopyFile := true;
  1573. end;
  1574.  
  1575. { This procedure handles displaying a user-friendly Dialog box with a }
  1576. { Message for Delphi IO exception errors.                             }
  1577. procedure TFileWorkBench.HandleIOException( TheOpCode : Integer;
  1578.            ThePath : String; TheMessage : String; TheCode : Integer );
  1579. var ErrorMessageString : String;  { Holds internal data }
  1580.     OperationString    : String;  { Holds internal data }
  1581. begin
  1582.   { clear to check for unrecognized code }
  1583.   ErrorMessageString := '';
  1584.   { Check against imported code }
  1585.   case TheCode of
  1586.     2    : ErrorMessageString := 'File not found';
  1587.     3    : ErrorMessageString := 'Path not found';
  1588.     4    : ErrorMessageString := 'Too many open files';
  1589.     5    : ErrorMessageString := 'File access denied';
  1590.     6    : ErrorMessageString := 'Invalid file handle';
  1591.     12    : ErrorMessageString := 'Invalid file access code';
  1592.     15    : ErrorMessageString := 'Invalid drive number';
  1593.     16  : ErrorMessageString := 'Cannot remove current directory';
  1594.     17    : ErrorMessageString := 'Cannot rename across drives';
  1595.     100    : ErrorMessageString := 'Disk read error';
  1596.     101    : ErrorMessageString := 'Disk write error';
  1597.     102    : ErrorMessageString := 'File not assigned';
  1598.     103    : ErrorMessageString := 'File not open';
  1599.     104    : ErrorMessageString := 'File not open for input';
  1600.     105    : ErrorMessageString := 'File not open for output';
  1601.   end;
  1602.   case TheOpCode of
  1603.     EOC_CHANGEDIR : OperationString := 'Unable to Change Directory due to ';
  1604.     EOC_SOURCECOPY : OperationString := 'Unable to Copy due to Source File ';
  1605.     EOC_DESTCOPY : OperationString := 'Unable to Copy due to Destination File ';
  1606.     EOC_DELETEFILE : OperationString := 'Unable to Delete File due to ';
  1607.     EOC_DELETEDIR : OperationString := 'Unable to Delete Directory due to ';
  1608.     EOC_RENAMEFILE : OperationString := 'Unable to Rename File due to ';
  1609.     EOC_MAKEDIR : OperationString := 'Unable to Create New Directory due to ';
  1610.     EOC_SETATTR : OperationString := 'Unable to Set File Attributes due to ';
  1611.   end;
  1612.   { If not recognized use message; not a DOS error; reset cursor for neatness }
  1613.   if ErrorMessageString = '' then
  1614.   begin
  1615.     Screen.Cursor := crDefault;
  1616.     MessageDlg( OperationString + ExtractFileName( ThePath ) + ' ' +
  1617.      TheMessage , mtError , [mbOK],0);
  1618.   end
  1619.   else
  1620.   begin
  1621.     { Recognized DOS exception, reset cursor for neatness }
  1622.     Screen.Cursor := crDefault;
  1623.     MessageDlg( OperationString + ExtractFileName( ThePath ) + ' ' +
  1624.      ErrorMessageString , mtError , [mbOK], 0 );
  1625.   end;
  1626. end;
  1627.  
  1628. { This procedure handles displaying a user-friendly Dialog box with a }
  1629. { Message for DOS error codes.                                        }
  1630. procedure TFileWorkBench.HandleDOSError( TheOpCode : Integer;
  1631.            ThePath : String;  TheCode : Integer );
  1632. var ErrorMessageString : String;  { internal message holder }
  1633.     OperationString : String;     { internal message holder }
  1634. begin
  1635.   { clear the message holder to check for unrecognized code }
  1636.   ErrorMessageString := '';
  1637.   { Negate the code back to normal number and check to set string }
  1638.   case -TheCode of
  1639.     2    : ErrorMessageString := 'File not found';
  1640.     3    : ErrorMessageString := 'Path not found';
  1641.     4    : ErrorMessageString := 'Too many open files';
  1642.     5    : ErrorMessageString := 'File access denied';
  1643.     6    : ErrorMessageString := 'Invalid file handle';
  1644.     12    : ErrorMessageString := 'Invalid file access code';
  1645.     15    : ErrorMessageString := 'Invalid drive number';
  1646.     16  : ErrorMessageString := 'Cannot remove current directory';
  1647.     17    : ErrorMessageString := 'Cannot rename across drives';
  1648.     100    : ErrorMessageString := 'Disk read error';
  1649.     101    : ErrorMessageString := 'Disk write error';
  1650.     102    : ErrorMessageString := 'File not assigned';
  1651.     103    : ErrorMessageString := 'File not open';
  1652.     104    : ErrorMessageString := 'File not open for input';
  1653.     105    : ErrorMessageString := 'File not open for output';
  1654.     157 : ErrormessageString := 'Could not open Source File';
  1655.     159 : ErrormessageString := 'Could not open Target File';
  1656.   end;
  1657.   case TheOpCode of
  1658.     EOC_CHANGEDIR : OperationString := 'Unable to Change Directory due to ';
  1659.     EOC_SOURCECOPY : OperationString := 'Unable to Copy due to Source File ';
  1660.     EOC_DESTCOPY : OperationString := 'Unable to Copy due to Destination File ';
  1661.     EOC_DELETEFILE : OperationString := 'Unable to Delete File due to ';
  1662.     EOC_DELETEDIR : OperationString := 'Unable to Delete Directory due to ';
  1663.     EOC_RENAMEFILE : OperationString := 'Unable to Rename File due to ';
  1664.     EOC_MAKEDIR : OperationString := 'Unable to Create New Directory due to ';
  1665.     EOC_SETATTR : OperationString := 'Unable to Set File Attributes due to ';
  1666.   end;
  1667.   { If the string is empty an unrecognized code was sent in }
  1668.   if ErrorMessageString = '' then
  1669.   begin
  1670.     { Sent up db based on source or target error; reset cursor for neatness }
  1671.     Screen.Cursor := crDefault;
  1672.     MessageDlg( OperationString + ExtractFileName( ThePath ) + ' Error Code: ' +
  1673.      IntToStr( TheCode ) , mtError , [mbOK],0);
  1674.   end
  1675.   else  { Code is recognized, use message from case statement }
  1676.   begin
  1677.     { Format the output for source or target error }
  1678.     Screen.Cursor := crDefault;
  1679.     MessageDlg( OperationString + ExtractFileName( ThePath ) + ' ' +
  1680.      ErrorMessageString , mtError , [mbOK], 0 );
  1681.   end;
  1682. end;
  1683.  
  1684. { This procedure sets the imported booleans to the file's attributes }
  1685. procedure TFileWorkBench.GetFileAttributes( TheFile : String; var IsDirectory ,
  1686.            IsArchive , IsVolumeID , IsHidden , IsReadOnly ,
  1687.             IsSysFile : Boolean );
  1688. var TheResult : Integer; { Traps for error code on VolumeID }
  1689. begin
  1690.   { Clear the imported flags for default }
  1691.   IsDirectory := false;
  1692.   IsArchive := false;
  1693.   IsVolumeID := false;
  1694.   IsHidden := False;
  1695.   IsReadOnly := false;
  1696.   IsSysFile := false;
  1697.   { Make the Dos call }
  1698.   TheResult := FileGetAttr( TheFile );
  1699.   if TheResult < 0 then
  1700.   begin
  1701.     { Volume ID returns -2 (?) }
  1702.     IsVolumeID := true;
  1703.     { It has no other properties }
  1704.     exit;
  1705.   end;
  1706.   { Use AND test to set all other properties }
  1707.   if (( TheResult and faDirectory ) = faDirectory ) then IsDirectory := true;
  1708.   if (( TheResult and faArchive ) = faArchive ) then IsArchive := true;
  1709.   if (( TheResult and faVolumeID ) = faVolumeID ) then IsVolumeID := true;
  1710.   if (( TheResult and faReadOnly ) = faReadOnly ) then IsReadOnly := true;
  1711.   if (( TheResult and faHidden ) = faHidden ) then IsHidden := true;
  1712.   if (( TheResult and faSysFile ) = faSysFile ) then IsSysFile := true;
  1713. end;
  1714.  
  1715. { This function makes sure a pathname has a trailing \ }
  1716. function TFileWorkBench.ForceTrailingBackSlash(
  1717.           const TheFileName : String ) : String;
  1718. var TempString : String;  { Used to hold function result }
  1719. begin
  1720.   { If no trailing \ add one (root will already have one.) }
  1721.   if TheFileName[ Length( TheFileName ) ] <> '\' then
  1722.    TempString := TheFileName + '\' else TempString := TheFileName;
  1723.   { Return modified or non-modified string }
  1724.   ForceTrailingBackslash := TempString;
  1725. end;
  1726.  
  1727. { This function makes sure a non-root dir has no trailing \ }
  1728. function TFileWorkBench.StripNonRootTrailingBackSlash(
  1729.           const TheFileName : String ) : String;
  1730. var TempString : String ; { Used to hold function result }
  1731. begin
  1732.   { Default is no change }
  1733.   TempString := TheFileName;
  1734.   { If not root then }
  1735.   if Length( TheFileName ) > 3 then
  1736.   begin
  1737.     { If has a trailing backslash remove it }
  1738.     if TheFileName[ Length( TheFileName )] = '\' then
  1739.     begin
  1740.       TempString := Copy( TheFileName , 1 ,
  1741.        Length( TheFileName ) - 1 );
  1742.     end;
  1743.   end;
  1744.   { Export the final result }
  1745.   StripNonRootTrailingBackSlash := TempString;
  1746. end;
  1747.  
  1748. { This gets the next selected listbox item }
  1749. function TIconFileListBox.GetNextSelection( SourceDirectory : String;
  1750.           var CurrentItem : Integer ): String;
  1751. var TheResult : String;  { Internal storage }
  1752.     finished  : boolean; { Loop flag        }
  1753. begin
  1754.   { If out of items to check signal and exit }
  1755.   if CurrentItem > Items.Count then TheResult := '' else
  1756.   begin
  1757.     { Otherwise scan from current position till match or end }
  1758.     finished := false;
  1759.     while not finished do
  1760.     begin
  1761.       { Check against selected property }
  1762.       if Selected[ CurrentItem - 1 ] then
  1763.       begin
  1764.         { If selected then return it and abort loop }
  1765.         TheResult := SourceDirectory + Items[ CurrentItem - 1 ];
  1766.         finished := true;
  1767.         { Increment current position }
  1768.         CurrentItem := CurrentItem + 1;
  1769.      end
  1770.       else
  1771.       begin
  1772.         { Increment current position }
  1773.         CurrentItem := CurrentItem + 1;
  1774.         { Otherwise check for end of data and abort if out of entries }
  1775.         if CurrentItem > Items.Count then
  1776.         begin
  1777.           TheResult := '';
  1778.           finished := true;
  1779.         end;
  1780.       end;
  1781.     end;
  1782.   end;
  1783.   { Return stored result }
  1784.   GetNextSelection := TheResult;
  1785. end;
  1786.  
  1787. { Modified from VCL Source Copyright 1995 }
  1788. { Borland International, Inc.             }
  1789. { Use this to override display with icons }
  1790. procedure TIconFileListBox.ReadFileNames;
  1791. var
  1792.   AttrIndex   : TFileAttr;
  1793.   i           : Integer;
  1794.   FileExt     : string;
  1795.   MaskPtr     : PChar;
  1796.   Ptr         : PChar;
  1797.   AttrWord    : Word;
  1798.   TempPicture : TPicture;
  1799.   TempBmp     : TBitmap;
  1800.   TempIcon    : TIcon;
  1801. const
  1802.   Attributes: array[TFileAttr] of Word =
  1803.   ( DDL_READONLY , DDL_HIDDEN , DDL_SYSTEM , $0008 , DDL_DIRECTORY ,
  1804.     DDL_ARCHIVE  , DDL_EXCLUSIVE );
  1805. begin
  1806.   { if no handle allocated yet, this call will force         }
  1807.   { one to be allocated incorrectly (i.e. at the wrong time. }
  1808.   { In due time, one will be allocated appropriately.        }
  1809.   AttrWord := DDL_READWRITE;
  1810.   if HandleAllocated then
  1811.   begin
  1812.     { Set attribute flags based on values in FileType }
  1813.     for AttrIndex := ftReadOnly to ftArchive do
  1814.      if AttrIndex in FileType then
  1815.       AttrWord := AttrWord or Attributes[ AttrIndex ];
  1816.  
  1817.     { Use Exclusive bit to exclude normal files }
  1818.     if not ( ftNormal in FileType ) then
  1819.       AttrWord := AttrWord or DDL_EXCLUSIVE;
  1820.  
  1821.     ChDir( FDirectory ); { go to the directory we want }
  1822.     Clear;               { clear the list }
  1823.  
  1824.     MaskPtr := FMask;
  1825.     while MaskPtr <> nil do
  1826.     begin
  1827.       Ptr := StrScan ( MaskPtr , ';' );
  1828.       if Ptr <> nil then  Ptr^ := #0;
  1829.       { build the list }
  1830.       SendMessage( Handle , LB_DIR , AttrWord , Longint( MaskPtr ));
  1831.       if Ptr <> nil then
  1832.       begin
  1833.         Ptr^ := ';';
  1834.         Inc ( Ptr );
  1835.       end;
  1836.       MaskPtr := Ptr;
  1837.     end;
  1838.     { Now add the bitmaps }
  1839.     {---------------------------- begin custom code --------------------------}
  1840.     { Create the TPicture for exchange purposes }
  1841.     TempPicture := TPicture.Create;
  1842.     { Set it to icon widths }
  1843.     TempPicture.Bitmap.Width := 32;
  1844.     TempPicture.Bitmap.Height := 32;
  1845.     { Run down the list }
  1846.     for i := 0 to Items.Count - 1 do
  1847.     begin
  1848.       { Create a New temporary icon }
  1849.       TempIcon := TIcon.Create;
  1850.       { Call the custom DRWS routine to get icon for a file }
  1851.       GetIconForFile( Items[ i ] , TempIcon );
  1852.       { Put the icon on the bitmap for the picture via draw }
  1853.       { Note 1 , 1 due to bug in Draw?                      }
  1854.       TempPicture.Bitmap.Canvas.Draw( 1 , 1 , TempIcon );
  1855.       { Create a temporary bitmap }
  1856.       TempBmp := TBitmap.Create;
  1857.       { Set its width to those of the previous object's bitmaps }
  1858.       TempBmp.Width := 16;
  1859.       TempBmp.Height := 15;
  1860.       { Resize the icon's bitmap to the smaller size with stretchdraw }
  1861.       TempBmp.Canvas.StretchDraw( Rect( 1 , 1 , 15 , 14 ) ,
  1862.        TempPicture.Bitmap );
  1863.       { Set the Objects list to the bitmap }
  1864.       Items.Objects[ i ] := TempBmp;
  1865.       { Free the icon each iteration; don't free the TempBmp as list does }
  1866.       TempIcon.Free;
  1867.     end;
  1868.     { Free the TPicture exchange element }
  1869.     TempPicture.Free;
  1870.     {------------------------ end custom code --------------------------------}
  1871.     Change;
  1872.   end;
  1873. end;
  1874.  
  1875. { Use this to respond to dbl-clicking FLB filename }
  1876. procedure TIconFileListBox.TheDblClick(Sender: TObject);
  1877. begin
  1878.   { Call shellexec as a wrapper around ShellExecute API call }
  1879.   { False indicates failure, signal error                    }
  1880.   if not ShellExec( ExpandFileName( Items[ ItemIndex ] ), '' , '', false ,
  1881.    SW_SHOWNORMAL , false ) then MessageDlg('Could not Shell out to ' +
  1882.     Items[ ItemIndex ] , mtError, [mbOK], 0);
  1883. end;
  1884.  
  1885. { Create method for FIP                                }
  1886. constructor TIconFileListBox.Create( AOwner : TComponent );
  1887. begin
  1888.   { call inherited -- VITAL! }
  1889.   inherited Create( AOwner );
  1890.   { set the mouse method }
  1891.   OnDblClick := TheDblClick;
  1892. end;
  1893.  
  1894. { Create method for FIP                                }
  1895. constructor TFileIconPanel.Create( AOwner : TComponent );
  1896. begin
  1897.   { call inherited -- VITAL! }
  1898.   inherited Create( AOwner );
  1899.   { create icon and label components, making self owner/displayer }
  1900.   FTheIcon := TIcon.Create;
  1901.   FTheLabel := TLabel.Create( Self );
  1902.   FThelabel.Parent := Self;
  1903.   { Set own and labels mouse methods to stored methods }
  1904.   OnMouseUp := TheMouseUp;
  1905.   OnMouseDown := TheMouseDown;
  1906.   OnMouseMove := TheMouseMove;
  1907.   OnDragOver := TheDragOver;
  1908.   OnDragDrop := TheDragDrop;
  1909.   { Set alignment and autosize properties of the label }
  1910.   FTheLabel.Autosize := false;
  1911.   FTheLabel.Alignment := taCenter;
  1912.   { Set selected to false }
  1913.   Selected := false;
  1914. end;
  1915.  
  1916. procedure TFileIconPanel.WMLButtonDblClk(var Message: TWMLButtonDblClk);
  1917. var CurrentDirectory : String;    { Use to store dirs }
  1918.     TheDrive         : String;    { Get drive letter  }
  1919.     WhichDrive       : Integer;   { Get drive number  }
  1920.     ErrorCheck       : Integer;
  1921.     TheFWB           : TFileWorkBench;
  1922. begin
  1923.   { Create FileWorkBench for later use }
  1924.   TheFWB := TFileWorkBench.Create( Self );
  1925.   { Check for label or FIP sender }
  1926.   if FTheLabel.Caption = '..' then
  1927.   begin { deal with backup request }
  1928.     { Change to New directory }
  1929.     TheFWB.ChangeTheDirectory( '..' );
  1930.     { Call special method due to SendMessage problem! }
  1931.     TFileIconPanelScrollBox( Parent ).Update;
  1932.   end
  1933.   else
  1934.   begin
  1935.     { Check for DRIVE id in name }
  1936.     if Pos( 'DRIVE' , FTheName ) <> 0 then
  1937.     begin { Double Click on a Drive Icon }
  1938.       { Pull out the letter from name }
  1939.       TheDrive := Copy( FtheName , 7 , 1 );
  1940.       { Convert it to a number }
  1941.       WhichDrive := ( Ord( TheDrive[ 1 ] ) - Ord( 'A' )) + 1;
  1942.       TheFWB.ChangeTheDriveAndDirectory( WhichDrive );
  1943.       { Call special method due to SendMessage problem! }
  1944.       TFileIconPanelScrollBox( Parent ).Update;
  1945.     end
  1946.     else
  1947.     begin { Double click on a dir/file icon }
  1948.       if (( FileGetAttr( FTheName ) and faDirectory ) = faDirectory ) then
  1949.       begin { A directory, change to it }
  1950.         { Since full path in name, simply change to it! }
  1951.         TheFWB.ChangeTheDirectory( FTheName );
  1952.         { Call special method due to SendMessage problem! }
  1953.         TFileIconPanelScrollBox( Parent ).Update;
  1954.       end
  1955.       else
  1956.       begin { A file; attempt to shellexecute it }
  1957.         { Call shellexec as a wrapper around ShellExecute API call }
  1958.         { False indicates failure, signal error                    }
  1959.         if not ShellExec( FTheName , '' , '', false , SW_SHOWNORMAL , false )
  1960.          then MessageDlg('Could not Shell out to ' + FTheName , mtError,
  1961.           [mbOK], 0);
  1962.       end;
  1963.     end;
  1964.   end;
  1965.   TheFWB.Free; { This prevents resource leak }
  1966. end;
  1967.  
  1968. { Initialization method for FIP                                         }
  1969. procedure TFileIconPanel.Initialize( PanelX              ,
  1970.                                      PanelY              ,
  1971.                                      PanelWidth          ,
  1972.                                      PanelHeight         ,
  1973.                                      PanelBevelWidth     ,
  1974.                                      LabelFontSize         : Integer;
  1975.                                      PanelColor          ,
  1976.                                      PanelHighlightColor ,
  1977.                                      PanelShadowColor    ,
  1978.                                      LabelTextColor        : TColor;
  1979.                                      TheFilename         ,
  1980.                                      LabelFontName         : String;
  1981.                                      LabelFontStyle        : TFontStyles;
  1982.                                      ExtraData             : Integer );
  1983.  
  1984. var TheLabelHeight ,             { Holder for label pixel height }
  1985.     TheLabelWidth    : Integer;  { Holder for label pixel width  }
  1986.     TheOtherPChar    : PChar;    { Windows ASCIIZ string         }
  1987. begin
  1988.   { Set the basic properties based on imported parameters }
  1989.   Left := PanelX;
  1990.   Top := PanelY;
  1991.   Width := PanelWidth;
  1992.   Height := PanelHeight;
  1993.   Color := PanelColor;
  1994.   BevelWidth := PanelBevelWidth;
  1995.   FHighlightColor := PanelHighlightColor;
  1996.   FShadowColor := PanelShadowColor;
  1997.   FTheName := TheFilename;
  1998.   { If the ExtraData field is non-0 then a drive is being sent in }
  1999.   if ExtraData <> 0 then
  2000.   begin
  2001.     { Use the data field value to determine which icon to get from RES file }
  2002.     case ExtraData of
  2003.       1 : begin
  2004.             GetMem( TheOtherPChar , 255 );
  2005.             StrPCopy( TheOtherPChar , 'FLOPPY35' );
  2006.             FTheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  2007.             FreeMem( TheOtherPChar , 255 );
  2008.           end;
  2009.       2 : begin
  2010.             GetMem( TheOtherPChar , 255 );
  2011.             StrPCopy( TheOtherPChar , 'FIXEDHD' );
  2012.             FTheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  2013.             FreeMem( TheOtherPChar , 255 );
  2014.           end;
  2015.       3 : begin
  2016.             GetMem( TheOtherPChar , 255 );
  2017.             StrPCopy( TheOtherPChar , 'NETWORKHD' );
  2018.             FTheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  2019.             FreeMem( TheOtherPChar , 255 );
  2020.           end;
  2021.       4 : begin
  2022.             GetMem( TheOtherPChar , 255 );
  2023.             StrPCopy( TheOtherPChar , 'CDROM' );
  2024.             FTheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  2025.             FreeMem( TheOtherPChar , 255 );
  2026.           end;
  2027.       5 : begin
  2028.             GetMem( TheOtherPChar , 255 );
  2029.             StrPCopy( TheOtherPChar , 'RAM' );
  2030.             FTheIcon.Handle := LoadIcon( hInstance , TheOtherPChar );
  2031.             FreeMem( TheOtherPChar , 255 );
  2032.           end;
  2033.     end;
  2034.     { The FileNme property is already set up for the caption; use directly }
  2035.     FTheLabel.Caption := TheFilename;
  2036.     { Set up the hint for later use (make sure to set ShowHint) }
  2037.     Hint := 'Change to ' + TheFileName;
  2038.     ShowHint := true;
  2039.     { Set up all imported label properties and center it for drawing }
  2040.     with FTheLabel do
  2041.     begin
  2042.       Font.Name := LabelFontName;
  2043.       Font.Size := LabelFontSize;
  2044.       Font.Style := LabelFontStyle;
  2045.       Font.Color := LabelTextColor;
  2046.       Canvas.Brush.Color := PanelColor;
  2047.       Canvas.Font := Font;
  2048.       TheLabelHeight := Canvas.Textheight( Caption ) + 4;
  2049.       TheLabelWidth := Canvas.Textwidth( Caption ) + 4;
  2050.       Left := (( Self.Width - TheLabelWidth ) div 2 ) + 1;
  2051.       Top := ((( Round( Self.Height * 0.25 ) - 6 ) - TheLabelHeight) div 2) + 1;
  2052.       Top := Top + Round( Self.Height * 0.75 );
  2053.       Height := TheLabelHeight;
  2054.       Width := TheLabelWidth;
  2055.     end;
  2056.   end
  2057.   else
  2058.   begin
  2059.     { A file or directory has been sent in; use GetIconForFile to obtain an }
  2060.     { icon either from the file, its owner, or a RES file default.          }
  2061.     GetIconForFile( FTheName , FTheIcon );
  2062.     { Check for the Backup caption and set it specially }
  2063.     if ExtractfileName( FThename ) = '..' then
  2064.     begin
  2065.       FTheLabel.Caption := '..';
  2066.       Hint := 'Up One Level';
  2067.     end
  2068.     else
  2069.     begin
  2070.       { Otherwise just get the filename for the label caption }
  2071.       { And the full path for the hint (used later.)          }
  2072.       FTheLabel.caption := ExtractFileName( UpperCase( FTheName ));
  2073.       Hint := FTheName;
  2074.     end;
  2075.     { Activate showhint so hints are seen }
  2076.     ShowHint := true;
  2077.     { Set label properties with imported values and center for display }
  2078.     with FTheLabel do
  2079.     begin
  2080.       Font.Name := LabelFontName;
  2081.       Font.Size := LabelFontSize;
  2082.       Font.Style := LabelFontStyle;
  2083.       Font.Color := LabelTextColor;
  2084.       Canvas.Brush.Color := PanelColor;
  2085.       Canvas.Font := Font;
  2086.       TheLabelHeight := Canvas.Textheight( Caption ) + 4;
  2087.       TheLabelWidth := Canvas.Textwidth( Caption ) + 4;
  2088.       Left := (( Self.Width - TheLabelWidth ) div 2 ) + 1;
  2089.       Top := ((( Round( Self.Height * 0.25 ) - 6 ) - TheLabelHeight) div 2) + 1;
  2090.       Top := Top + Round( Self.Height * 0.75 );
  2091.       Height := TheLabelHeight;
  2092.       Width := TheLabelWidth;
  2093.     end;
  2094.   end;
  2095. end;
  2096.  
  2097. { Destroy method for FIP }
  2098. destructor TFileIconPanel.Destroy;
  2099. begin
  2100.   { free component resources }
  2101.   FTheIcon.Free;
  2102.   FTheLabel.Free;
  2103.   { call inherited -- VITAL! }
  2104.   inherited Destroy;
  2105. end;
  2106.  
  2107. { Mousedown method for FIP; used to allow dragging }
  2108. procedure TFileIconPanel.TheMouseDown(Sender: TObject;
  2109.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  2110. var ThePoint , TheOtherPoint : TPoint;
  2111. begin
  2112.   { Begin a conditional drag operation (false allows timer) }
  2113.   TheIOManager.WhichButton := Button;
  2114.   TheIOManager.WhichState := Shift;
  2115.   { Currently ignore drive clicks }
  2116.   if Pos( 'DRIVE' , FTheName ) > 0 then exit;
  2117.   if (( Button = mbRight ) and ( ssShift in Shift )) then
  2118.   begin
  2119.     TheTempBitmap := TBitmap.Create;
  2120.     TheTempBitmap.Width := Self.Width;
  2121.     TheTempBitmap.Height := Self.Height;
  2122.     TheTempBitmap.Canvas.Copyrect( Rect( 0 , 0 , Self.Width , Self.Height ) ,
  2123.      Self.Canvas , Rect( 0 , 0 , Self.Width , Self.Height ));
  2124.     TheMouseManager.InitializeBitmap( TheTempBitmap );
  2125.     ThePoint.X := X;
  2126.     ThePoint.Y := Y;
  2127.     TheOtherPoint := ClientToScreen( ThePoint );
  2128.     TheMouseManager.StartBitmapCursor( TheOtherPoint.X , TheOtherPoint.Y );
  2129.     BitmapDragging := true;
  2130.     GlobalSource := Self;
  2131.     exit;
  2132.   end;
  2133.   if Button = mbRight then
  2134.   begin
  2135.     TheMouseManager.InitializeIcon( FTheIcon );
  2136.     ThePoint.X := X;
  2137.     ThePoint.Y := Y;
  2138.     TheOtherPoint := ClientToScreen( ThePoint );
  2139.     TheMouseManager.StartIconCursor( TheOtherPoint.X , TheOtherPoint.Y );
  2140.     IconDragging := true;
  2141.     GlobalSource := Self;
  2142.     exit;
  2143.   end;
  2144.   BeginDrag( false );
  2145.   { Flip status of bevels }
  2146.   if BevelOuter = bvRaised then BevelOuter := bvLowered else
  2147.    BevelOuter := bvRaised;
  2148.   { Flip selected variable }
  2149.   Selected := not Selected;
  2150.   { Set redisplay }
  2151. end;
  2152.  
  2153. procedure TFileIconPanel.TheMouseMove(Sender: TObject; Shift: TShiftState;
  2154.   X, Y: Integer);
  2155. var ThePoint, TheOtherPoint : TPoint;
  2156. begin
  2157.   if IconDragging then
  2158.   begin
  2159.     ThePoint.X := X;
  2160.     ThePoint.Y := Y;
  2161.     TheOtherPoint := ClientToScreen( ThePoint );
  2162.     TheMouseManager.MoveIconCursor( TheOtherPoint.X , TheOtherPoint.Y );
  2163.     exit;
  2164.   end;
  2165.   if BitmapDragging then
  2166.   begin
  2167.     ThePoint.X := X;
  2168.     ThePoint.Y := Y;
  2169.     TheOtherPoint := ClientToScreen( ThePoint );
  2170.     TheMouseManager.MoveBitmapCursor( TheOtherPoint.X , TheOtherPoint.Y );
  2171.     exit;
  2172.   end;
  2173. end;
  2174.  
  2175. { Mouseup Method for FIP; used to allow dragging }
  2176. procedure TFileIconPanel.TheMouseUp(Sender: TObject;
  2177.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  2178. begin
  2179.   if IconDragging then
  2180.   begin
  2181.     TheMouseManager.EndIconCursor( X , Y );
  2182.     IconDragging := false;
  2183.     if GlobalSource <> Self then
  2184.     begin { Right-drag onto a panel! }
  2185.       TheDragDrop( Sender , GlobalSource , X , Y );
  2186.     end;
  2187.     exit;
  2188.   end;
  2189.   if BitmapDragging then
  2190.   begin
  2191.     TheMouseManager.EndBitmapCursor( X , Y );
  2192.     BitmapDragging := false;
  2193.     if GlobalSource <> Self then
  2194.     begin { Right-drag onto a panel! }
  2195.       TheDragDrop( Sender , GlobalSource , X , Y );
  2196.     end;
  2197.     exit;
  2198.   end;
  2199.   { End a drag operation without dropping; if dragged OK }
  2200.   { already handled.                                     }
  2201.   EndDrag( false );
  2202.   { If the right button is clicked, perform magic! }
  2203.   { Redisplay on general principles }
  2204.   Invalidate;
  2205. end;
  2206.  
  2207. { Use this to generically OK DnD from FIPs }
  2208. procedure TFileIconPanel.TheDragOver(Sender, Source: TObject; X,
  2209.   Y: Integer; State: TDragState; var Accept: Boolean);
  2210. begin
  2211.   { Only accept from FileIconPanel components }
  2212.   if Source is TFileIconPanel then Accept := true else Accept := false;
  2213. end;
  2214.  
  2215. { Use this to accept Drag and Drop from other FIPs }
  2216. procedure TFileIconPanel.TheDragDrop(Sender, Source: TObject; X,
  2217.   Y: Integer);
  2218. var CurrentName ,                 { Holds work name}
  2219.     TheOldString : String;        { Holds Dir      }
  2220.     TargetDir    : String;        { target of op   }
  2221.     TheResult       : Integer;    { Modal res hold }
  2222.     SourceDirectory,
  2223.     TargetDirectory,
  2224.     CurrentDirectory : String;    { Use to store dirs }
  2225.     TheDrive         : String;    { Get drive letter  }
  2226.     WhichDrive       : Integer;   { Get drive number  }
  2227.     ErrorCheck       : Integer;
  2228.     TheFWB           : TFileWorkBench;
  2229.     ThePosition : Integer;
  2230.     Finished : Boolean;
  2231.     TheFIPSB : TFileIconPanelScrollBox;
  2232. begin
  2233.   { If drop target is .. then ignore }
  2234.   if FTheLabel.Caption = '..' then exit;
  2235.   { Likewise ignore Dnd from drive icons }
  2236.   if Pos( 'DRIVE' , TFileIconPanel( Source ).FtheName ) > 0 then exit;
  2237.   { Obtain the parent of the source FIP; may not be self }
  2238.   TheFIPSB := TFileIconPanelScrollBox( TFileIconPanel( Source ).Parent );
  2239.   { Obtain source directory either as Dir or filepath }
  2240.   if (( FileGetAttr( TFileIconPanel( Source ).FTheName )
  2241.    and faDirectory ) = faDirectory ) then
  2242.   begin  { Directory; take whole path }
  2243.     SourceDirectory := TFileIconPanel( Source ).FTheName;
  2244.   end
  2245.   else
  2246.   begin { File; get pathname }
  2247.     SourceDirectory := ExtractFilePath( TFileIconPanel( Source ).FTheName );
  2248.   end;
  2249.   Sourcedirectory := TheFIPSB.TheFWB.ForceTrailingBackSlash( SourceDirectory );
  2250.   if Pos( 'DRIVE' , FTheName ) > 0 then
  2251.   begin { Drop onto a drive icon; perform action to its default dir }
  2252.     { Pull out the letter from name }
  2253.     TheDrive := Copy( FtheName , 7 , 1 );
  2254.     { Convert it to a number }
  2255.     WhichDrive := ( Ord( TheDrive[ 1 ] ) - Ord( 'A' )) + 1;
  2256.     { Determine the target directory and drive }
  2257.     GetDir( WhichDrive , TargetDirectory );
  2258.     TargetDirectory := TheFIPSB.TheFWB.ForceTrailingbackSlash( TargetDirectory );
  2259.     { Check for shift to operate on all selections }
  2260.     if TheIOManager.WasSHIFTPressed then
  2261.     begin { Operate on all selections }
  2262.       { Obtain the parent directory of the FIP dragged over }
  2263.       SourceDirectory := ExtractFilePath( TFileIconPanel( Source ).FTheName );
  2264.       SourceDirectory := TheFIPSB.TheFWB.ForceTrailingBackslash( SourceDirectory );
  2265.       { If SourceDir subset of TargetDir then abort; recursive failure }
  2266.       if Pos( SourceDirectory , TargetDirectory ) > 0 then
  2267.       begin
  2268.         MessageDlg( 'Cannot drag to same directory!',mtError,[mbOK],0 );
  2269.         exit;
  2270.       end;
  2271.       if TargetDirectory[ 1 ] <> SourceDirectory[ 1 ] then
  2272.       begin { Copy to different drives }
  2273.         if TheIOManager.WasALTPressed then
  2274.         begin { ALT overrides and does move }
  2275.           { Set up to get all current selections }
  2276.           ThePosition := 1;
  2277.           finished := false;
  2278.           while not finished do
  2279.           begin
  2280.             CurrentName := TheFIPSB.GetNextSelection( SourceDirectory ,
  2281.                    ThePosition );
  2282.             { If returns blank string then out of selections }
  2283.             if CurrentName = '' then finished := true else
  2284.             begin
  2285.               { If a directory signal error }
  2286.               if (( FileGetAttr( CurrentName ) and faDirectory ) = faDirectory ) then
  2287.               begin
  2288.                 if MessageDlg( 'Move Directory ' + CurrentName + ' to ' +
  2289.                  TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2290.                   TheFIPSB.TheFWB.RecursivelyMoveDirectory( CurrentName ,
  2291.                    TargetDirectory );
  2292.               end
  2293.               else
  2294.               begin
  2295.                 TheFIPSB.TheFWB.MoveTheFile( CurrentName , TargetDirectory );
  2296.               end;
  2297.             end;
  2298.             { Reset to normal cursor }
  2299.             Screen.Cursor := crDefault;
  2300.           end;
  2301.         end
  2302.         else
  2303.         begin { Default is to do copy like file manager }
  2304.           { Set up to get all current selections }
  2305.           ThePosition := 1;
  2306.           finished := false;
  2307.           while not finished do
  2308.           begin
  2309.              CurrentName := TheFIPSB.GetNextSelection( SourceDirectory ,
  2310.                    ThePosition );
  2311.             { If returns blank string then out of selections }
  2312.             if CurrentName = '' then finished := true else
  2313.             begin
  2314.               { If a directory signal error }
  2315.               if (( FileGetAttr( CurrentName ) and faDirectory ) = faDirectory ) then
  2316.               begin
  2317.                 if MessageDlg( 'Copy Directory ' + CurrentName + ' to ' +
  2318.                  TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2319.                   TheFIPSB.TheFWB.RecursivelyCopyDirectory( CurrentName ,
  2320.                    TargetDirectory );
  2321.               end
  2322.               else
  2323.               begin
  2324.                 TheFIPSB.TheFWB.CopyTheFile( CurrentName , TargetDirectory );
  2325.               end;
  2326.             end;
  2327.             { Reset to normal cursor }
  2328.             Screen.Cursor := crDefault;
  2329.           end;
  2330.         end;
  2331.       end
  2332.       else
  2333.       begin { Copy to same drive }
  2334.         if TheIOManager.WasCTRLPressed then
  2335.         begin { CTRL overrides and does copy }
  2336.           { Set up to get all current selections }
  2337.           ThePosition := 1;
  2338.           finished := false;
  2339.           while not finished do
  2340.           begin
  2341.             CurrentName := TheFIPSB.GetNextSelection( SourceDirectory ,
  2342.                    ThePosition );
  2343.             { If returns blank string then out of selections }
  2344.             if CurrentName = '' then finished := true else
  2345.             begin
  2346.               { If a directory signal error }
  2347.               if (( FileGetAttr( CurrentName ) and faDirectory ) = faDirectory ) then
  2348.               begin
  2349.                 if MessageDlg( 'Copy Directory ' + CurrentName + ' to ' +
  2350.                  TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2351.                   TheFIPSB.TheFWB.RecursivelyCopyDirectory( CurrentName ,
  2352.                    TargetDirectory );
  2353.               end
  2354.               else
  2355.               begin
  2356.                 TheFIPSB.TheFWB.CopyTheFile( CurrentName , TargetDirectory );
  2357.               end;
  2358.             end;
  2359.             { Reset to normal cursor }
  2360.             Screen.Cursor := crDefault;
  2361.           end;
  2362.         end
  2363.         else
  2364.         begin { Default is to do move like file manager }
  2365.           { Set up to get all current selections }
  2366.           ThePosition := 1;
  2367.           finished := false;
  2368.           while not finished do
  2369.           begin
  2370.             CurrentName := TheFIPSB.GetNextSelection( SourceDirectory ,
  2371.                    ThePosition );
  2372.             { If returns blank string then out of selections }
  2373.             if CurrentName = '' then finished := true else
  2374.             begin
  2375.               { If a directory signal error }
  2376.               if (( FileGetAttr( CurrentName ) and faDirectory ) = faDirectory ) then
  2377.               begin
  2378.                 if MessageDlg( 'Move Directory ' + CurrentName + ' to ' +
  2379.                  TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2380.                   TheFIPSB.TheFWB.RecursivelyMoveDirectory( CurrentName ,
  2381.                    TargetDirectory );
  2382.               end
  2383.               else
  2384.               begin
  2385.                 TheFIPSB.TheFWB.MoveTheFile( CurrentName , TargetDirectory );
  2386.               end;
  2387.             end;
  2388.             { Reset to normal cursor }
  2389.             Screen.Cursor := crDefault;
  2390.           end;
  2391.         end;
  2392.       end;
  2393.     end
  2394.     else
  2395.     begin { Operate on only source }
  2396.       if TargetDirectory[ 1 ] <> SourceDirectory[ 1 ] then
  2397.       begin { Copy to different drives }
  2398.         if TheIOManager.WasALTPressed then
  2399.         begin { ALT overrides and does move }
  2400.           with Source as TFileIconPanel do
  2401.           begin
  2402.             if MessageDlg( 'Move ' + FTheName + ' to ' +
  2403.              TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2404.               TheFIPSB.TheFWB.MoveTheFile( FTheName , TargetDirectory );
  2405.           end;
  2406.         end
  2407.         else
  2408.         begin { Default is to do copy like file manager }
  2409.           with Source as TFileIconPanel do
  2410.           begin
  2411.             if MessageDlg( 'Copy ' + FTheName + ' to ' +
  2412.              TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2413.               TheFIPSB.TheFWB.CopyTheFile( FtheName , TargetDirectory );
  2414.           end;
  2415.         end;
  2416.       end
  2417.       else
  2418.       begin { Copy to same drive }
  2419.         if TheIOManager.WasCTRLPressed then
  2420.         begin { CTRL overrides and does copy }
  2421.           with Source as TFileIconPanel do
  2422.           begin
  2423.             if MessageDlg( 'Copy ' + FTheName + ' to ' +
  2424.              TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2425.               TheFIPSB.TheFWB.CopyTheFile( FTheName , TargetDirectory );
  2426.           end;
  2427.         end
  2428.         else
  2429.         begin { Default is to do move like file manager }
  2430.           with Source as TFileIconPanel do
  2431.           begin
  2432.             if MessageDlg( 'Move ' + FTheName + ' to ' +
  2433.              TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2434.              TheFIPSB.TheFWB.MoveTheFile( FtheName , TargetDirectory );
  2435.           end;
  2436.         end;
  2437.       end;
  2438.     end;
  2439.   end
  2440.   else
  2441.   begin { Drop onto dir or file icon }
  2442.     if (( FileGetAttr( FTheName ) and faDirectory ) = faDirectory ) then
  2443.     begin { Drop onto a directory; use its path as target }
  2444.       TargetDirectory := FTheName;
  2445.     end
  2446.     else
  2447.     begin { Drop onto a file; use its parent as target }
  2448.       TargetDirectory := ExtractFilePath( FTheName );
  2449.     end;
  2450.     Targetdirectory := TheFIPSB.TheFWB.ForceTrailingbackslash( TargetDirectory );
  2451.     { Check for shift to operate on all selections }
  2452.     if TheIOManager.WasSHIFTPressed then
  2453.     begin { Operate on all selections }
  2454.       { Obtain the parent directory of the FIP dragged over }
  2455.       SourceDirectory := ExtractFilePath( TFileIconPanel( Source ).FTheName );
  2456.       SourceDirectory := TheFIPSB.TheFWB.ForceTrailingBackslash( SourceDirectory );
  2457.       { If SourceDir subset of TargetDir then abort; recursive failure }
  2458.       if Pos( SourceDirectory , TargetDirectory ) > 0 then
  2459.       begin
  2460.         MessageDlg( 'Cannot drag to same directory!',mtError,[mbOK],0 );
  2461.         exit;
  2462.       end;
  2463.       if TargetDirectory[ 1 ] <> SourceDirectory[ 1 ] then
  2464.       begin { Copy to different drives }
  2465.         if TheIOManager.WasALTPressed then
  2466.         begin { ALT overrides and does move }
  2467.           { Set up to get all current selections }
  2468.           ThePosition := 1;
  2469.           finished := false;
  2470.           while not finished do
  2471.           begin
  2472.              CurrentName := TheFIPSB.GetNextSelection( SourceDirectory ,
  2473.                    ThePosition );
  2474.             { If returns blank string then out of selections }
  2475.             if CurrentName = '' then finished := true else
  2476.             begin
  2477.               { If a directory signal error }
  2478.               if (( FileGetAttr( CurrentName ) and faDirectory ) = faDirectory ) then
  2479.               begin
  2480.                 if MessageDlg( 'Move Directory ' + CurrentName + ' to ' +
  2481.                  TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2482.                   TheFIPSB.TheFWB.RecursivelyMoveDirectory( CurrentName ,
  2483.                    TargetDirectory );
  2484.               end
  2485.               else
  2486.               begin
  2487.                 TheFIPSB.TheFWB.MoveTheFile( CurrentName , TargetDirectory );
  2488.               end;
  2489.             end;
  2490.             { Reset to normal cursor }
  2491.             Screen.Cursor := crDefault;
  2492.           end;
  2493.         end
  2494.         else
  2495.         begin { Default is to do copy like file manager }
  2496.           { Set up to get all current selections }
  2497.           ThePosition := 1;
  2498.           finished := false;
  2499.           while not finished do
  2500.           begin
  2501.             CurrentName := TheFIPSB.GetNextSelection( SourceDirectory ,
  2502.                    ThePosition );
  2503.             { If returns blank string then out of selections }
  2504.             if CurrentName = '' then finished := true else
  2505.             begin
  2506.               { If a directory signal error }
  2507.               if (( FileGetAttr( CurrentName ) and faDirectory ) = faDirectory ) then
  2508.               begin
  2509.                 if MessageDlg( 'Copy Directory ' + CurrentName + ' to ' +
  2510.                  TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2511.                   TheFIPSB.TheFWB.RecursivelyCopyDirectory( CurrentName ,
  2512.                    TargetDirectory );
  2513.               end
  2514.               else
  2515.               begin
  2516.                 TheFIPSB.TheFWB.CopyTheFile( CurrentName , TargetDirectory );
  2517.               end;
  2518.             end;
  2519.             { Reset to normal cursor }
  2520.             Screen.Cursor := crDefault;
  2521.           end;
  2522.         end;
  2523.       end
  2524.       else
  2525.       begin { Copy to same drive }
  2526.         if TheIOManager.WasCTRLPressed then
  2527.         begin { CTRL overrides and does copy }
  2528.           { Set up to get all current selections }
  2529.           ThePosition := 1;
  2530.           finished := false;
  2531.           while not finished do
  2532.           begin
  2533.             { Call generic file getting routine based on current view}
  2534.              CurrentName := TheFIPSB.GetNextSelection( SourceDirectory ,
  2535.                    ThePosition );
  2536.             { If returns blank string then out of selections }
  2537.             if CurrentName = '' then finished := true else
  2538.             begin
  2539.               { If a directory signal error }
  2540.               if (( FileGetAttr( CurrentName ) and faDirectory ) = faDirectory ) then
  2541.               begin
  2542.                 if MessageDlg( 'Copy Directory ' + CurrentName + ' to ' +
  2543.                  TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2544.                   TheFIPSB.TheFWB.RecursivelyCopyDirectory( CurrentName ,
  2545.                    TargetDirectory );
  2546.               end
  2547.               else
  2548.               begin
  2549.                 TheFIPSB.TheFWB.CopyTheFile( CurrentName , TargetDirectory );
  2550.               end;
  2551.             end;
  2552.             { Reset to normal cursor }
  2553.             Screen.Cursor := crDefault;
  2554.           end;
  2555.         end
  2556.         else
  2557.         begin { Default is to do move like file manager }
  2558.           { Set up to get all current selections }
  2559.           ThePosition := 1;
  2560.           finished := false;
  2561.           while not finished do
  2562.           begin
  2563.             { Call generic file getting routine based on current view}
  2564.               CurrentName := TheFIPSB.GetNextSelection( SourceDirectory ,
  2565.                    ThePosition );
  2566.             { If returns blank string then out of selections }
  2567.             if CurrentName = '' then finished := true else
  2568.             begin
  2569.               { If a directory signal error }
  2570.               if (( FileGetAttr( CurrentName ) and faDirectory ) = faDirectory ) then
  2571.               begin
  2572.                 if MessageDlg( 'Move Directory ' + CurrentName + ' to ' +
  2573.                  TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2574.                   TheFIPSB.TheFWB.RecursivelyMoveDirectory( CurrentName ,
  2575.                    TargetDirectory );
  2576.               end
  2577.               else
  2578.               begin
  2579.                 TheFIPSB.TheFWB.MoveTheFile( CurrentName , TargetDirectory );
  2580.               end;
  2581.             end;
  2582.             { Reset to normal cursor }
  2583.             Screen.Cursor := crDefault;
  2584.           end;
  2585.         end;
  2586.       end;
  2587.     end
  2588.     else
  2589.     begin { Operate on only source }
  2590.       if TargetDirectory[ 1 ] <> SourceDirectory[ 1 ] then
  2591.       begin { Copy to different drives }
  2592.         if TheIOManager.WasALTPressed then
  2593.         begin { ALT overrides and does move }
  2594.           with Source as TFileIconPanel do
  2595.           begin
  2596.             if (( FileGetAttr( FTheName ) and faDirectory ) = faDirectory ) then
  2597.             begin
  2598.               if MessageDlg( 'Move Directory ' + FTheName + ' to ' +
  2599.                TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2600.                 TheFIPSB.TheFWB.RecursivelyMoveDirectory( FtheName ,
  2601.                  TargetDirectory );
  2602.             end
  2603.             else
  2604.             begin
  2605.               if MessageDlg( 'Move ' + FTheName + ' to ' +
  2606.                TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2607.                 TheFIPSB.TheFWB.MoveTheFile( FTheName , TargetDirectory );
  2608.             end;
  2609.           end;
  2610.         end
  2611.         else
  2612.         begin { Default is to do copy like file manager }
  2613.           with Source as TFileIconPanel do
  2614.           begin
  2615.             if (( FileGetAttr( FTheName ) and faDirectory ) = faDirectory ) then
  2616.             begin
  2617.               if MessageDlg( 'Copy Directory ' + FtheName + ' to ' +
  2618.                TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2619.                 TheFIPSB.TheFWB.RecursivelyCopyDirectory( FtheName ,
  2620.                  TargetDirectory );
  2621.             end
  2622.             else
  2623.             begin
  2624.               if MessageDlg( 'Copy ' + FTheName + ' to ' +
  2625.                TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2626.                 TheFIPSB.TheFWB.CopyTheFile( FTheName , TargetDirectory );
  2627.             end;
  2628.           end;
  2629.         end;
  2630.       end
  2631.       else
  2632.       begin { Copy to same drive }
  2633.         if TheIOManager.WasCTRLPressed then
  2634.         begin { CTRL overrides and does copy }
  2635.           with Source as TFileIconPanel do
  2636.           begin
  2637.             if (( FileGetAttr( FTheName ) and faDirectory ) = faDirectory ) then
  2638.             begin
  2639.               if MessageDlg( 'Copy Directory ' + FtheName + ' to ' +
  2640.                TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2641.                 TheFIPSB.TheFWB.RecursivelyCopyDirectory( FtheName ,
  2642.                  TargetDirectory );
  2643.             end
  2644.             else
  2645.             begin
  2646.               if MessageDlg( 'Copy ' + FTheName + ' to ' +
  2647.                TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2648.                 TheFIPSB.TheFWB.CopyTheFile( FTheName , TargetDirectory );
  2649.             end;
  2650.           end;
  2651.         end
  2652.         else
  2653.         begin { Default is to do move like file manager }
  2654.           with Source as TFileIconPanel do
  2655.           begin
  2656.             if (( FileGetAttr( FTheName ) and faDirectory ) = faDirectory ) then
  2657.             begin
  2658.               if MessageDlg( 'Move Directory ' + FtheName + ' to ' +
  2659.                TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2660.                 TheFIPSB.TheFWB.RecursivelyMoveDirectory( FtheName ,
  2661.                  TargetDirectory );
  2662.             end
  2663.             else
  2664.             begin
  2665.               if MessageDlg( 'Move ' + FTheName + ' to ' +
  2666.                TargetDirectory + '?' , mtConfirmation , mbYesNoCancel , 0 ) = mrYes then
  2667.                 TheFIPSB.TheFWB.MoveTheFile( FTheName , TargetDirectory );
  2668.             end;
  2669.           end;
  2670.         end;
  2671.       end;
  2672.     end;
  2673.   end;
  2674.   { Call special method due to SendMessage problem! }
  2675.   TFileIconPanelScrollBox( TFileIconPanel( Source ).Parent ).Update;
  2676.   TFileIconPanelScrollBox( Parent ).Update;
  2677. end;
  2678.  
  2679. { Paint method for FIP; overrides normal paint }
  2680. procedure TFileIconPanel.Paint;
  2681. var
  2682.   TheOtherRect   : TRect;   { Holds clientrect   }
  2683.   TopColor     ,            { Holds bright color }
  2684.   BottomColor    : TColor;  { Holds dark color   }
  2685.  
  2686. { These methods are from Borland Intl., copyright 1995 }
  2687. procedure Frame3D(    Canvas       : TCanvas;
  2688.                   var TheRect      : TRect;
  2689.                       TopColor   ,
  2690.                       BottomColor  : TColor;
  2691.                       Width        : Integer );
  2692.  
  2693. procedure DoRect;
  2694. var
  2695.   TopRight, BottomLeft: TPoint;
  2696. begin
  2697.   with Canvas, TheRect do
  2698.   begin
  2699.     TopRight.X := Right;
  2700.     TopRight.Y := Top;
  2701.     BottomLeft.X := Left;
  2702.     BottomLeft.Y := Bottom;
  2703.     Pen.Color := TopColor;
  2704.     PolyLine([BottomLeft, TopLeft, TopRight]);
  2705.     Pen.Color := BottomColor;
  2706.     Dec(BottomLeft.X);
  2707.     PolyLine([TopRight, BottomRight, BottomLeft]);
  2708.   end;
  2709. end;
  2710.  
  2711. begin
  2712.   Canvas.Pen.Width := 1;
  2713.   Dec(TheRect.Bottom); Dec(TheRect.Right);
  2714.   while Width > 0 do
  2715.   begin
  2716.     Dec(Width);
  2717.     DoRect;
  2718.     InflateRect(TheRect, -1, -1);
  2719.   end;
  2720.   Inc(TheRect.Bottom); Inc(TheRect.Right);
  2721. end;
  2722.  
  2723. procedure AdjustColors(Bevel: TPanelBevel);
  2724. begin
  2725.   TopColor := FHighlightColor;
  2726.   if Bevel = bvLowered then TopColor := FShadowColor;
  2727.   BottomColor := FShadowColor;
  2728.   if Bevel = bvLowered then BottomColor := FHighlightColor;
  2729. end;
  2730.  
  2731. { Custom code begins here }
  2732. begin
  2733.   { Get the rectangle of the control with API/method call }
  2734.   TheOtherRect := GetClientRect;
  2735.   { draw basic rectangle with basic color }
  2736.   with Canvas do
  2737.   begin
  2738.     Brush.Color := Color;
  2739.     FillRect(TheOtherRect);
  2740.   end;
  2741.   { Set up for top "icon" frame  and draw it with frame3d }
  2742.   TheOtherRect.Right := Width;
  2743.   TheOtherRect.Bottom := Round( Height * 0.75 ) - 6 ;
  2744.   if BevelOuter <> bvNone then
  2745.   begin
  2746.     AdjustColors(BevelOuter);
  2747.     Frame3D(Canvas, TheOtherRect, TopColor, BottomColor, BevelWidth);
  2748.   end;
  2749.   Frame3D(Canvas, TheOtherRect, Color, Color, BorderWidth);
  2750.   if BevelInner <> bvNone then
  2751.   begin
  2752.     AdjustColors(BevelInner);
  2753.     Frame3D(Canvas, TheOtherRect, TopColor, BottomColor, BevelWidth);
  2754.   end;
  2755.   { Do the same for the lower "label" frame }
  2756.   TheOtherRect.Top := Round( Height * 0.75 ) - 5;
  2757.   TheOtherRect.Left := 0;
  2758.   TheOtherRect.Bottom := Height;
  2759.   TheOtherRect.Right := Width;
  2760.   if BevelOuter <> bvNone then
  2761.   begin
  2762.     AdjustColors(BevelOuter);
  2763.     Frame3D(Canvas, TheOtherRect, TopColor, BottomColor, BevelWidth);
  2764.   end;
  2765.   Frame3D(Canvas, TheOtherRect, Color, Color, BorderWidth);
  2766.   if BevelInner <> bvNone then
  2767.   begin
  2768.     AdjustColors(BevelInner);
  2769.     Frame3D(Canvas, TheOtherRect, TopColor, BottomColor, BevelWidth);
  2770.   end;
  2771.   { Then draw the icon using canvas draw method }
  2772.   Canvas.Draw( (( Width - 32 ) div 2 ) + 1 ,
  2773.   ((( Round( Height * 0.75 ) - 6 ) - 32 ) div 2 ) + 1 , FTheIcon );
  2774. end;
  2775.  
  2776. { This procedure clears a scrollbox of all FileIconPanels }
  2777. procedure TFileIconPanelScrollbox.ClearTheFIPs;
  2778. var Counter_1 : Integer;
  2779.     TheComponent : TComponent;
  2780. begin
  2781.   { Note that must use while loop since component count continually }
  2782.   { decreases as removes are made!                                  }
  2783.   while ComponentCount > 0 do
  2784.   begin
  2785.     { Save the component as a generic TComponent }
  2786.     TheComponent := Components[ 0 ];
  2787.     { Call removecomponent to pull it out of the owner list for sb }
  2788.     { This avoids GPF when freeing the sb.                         }
  2789.     RemoveComponent( Components[ 0 ]);
  2790.     if ControlCount > 0 then
  2791.      RemoveControl( Controls[ 0 ] );
  2792.     { Typecast the pointer and free it to release memory and res. }
  2793.     TheParentForm.InsertComponent( TheComponent );
  2794.   end;
  2795. end;
  2796.  
  2797. { This procedure scans for drives and obtains their type and creates file }
  2798. { icon panels to represent them.                                          }
  2799. procedure TFileIconPanelScrollBox.AddDriveIcons( var XCounter ,
  2800.            YCounter : Integer );
  2801. type
  2802.   { This if from filectrl unit; reproduce here for completeness }
  2803.   TDriveType = (dtUnknown, dtNoDrive, dtFloppy, dtFixed, dtNetwork, dtCDROM,
  2804.                 dtRAM);
  2805. var
  2806.   DriveNum        : Integer;         { Used to get next drive via DOS fn   }
  2807.   IconType        : Integer;         { Used to hold icon type (defacto dt) }
  2808.   DriveChar       : Char;            { Used to hold drive letter           }
  2809.   DriveType       : TDriveType;      { Used for set-valued drive type      }
  2810.   Finished        : Boolean;         { Loop flag                           }
  2811.   TheFIP          : TFileIconPanel;  { Generic FileIconPanel variable      }
  2812.   ButtonColor   ,                    { Main panel color                    }
  2813.   ButtonHLColor ,                    { Bright panel color                  }
  2814.   ButtonSColor  ,                    { Dark panel color                    }
  2815.   Textcolor       : TColor;          { Label text color                    }
  2816.  
  2817. { This code is from the FileCtrl Unit; copyright Borland Intl 1995      }
  2818. { Check whether drive is a CD-ROM.  Returns True if MSCDEX is installed }
  2819. {  and the drive is using a CD driver                                   }
  2820.  
  2821. function IsCDROM(DriveNum: Integer): Boolean; assembler;
  2822. asm
  2823.   MOV   AX,1500h { look for MSCDEX }
  2824.   XOR   BX,BX
  2825.   INT   2fh
  2826.   OR    BX,BX
  2827.   JZ    @Finish
  2828.   MOV   AX,150Bh { check for using CD driver }
  2829.   MOV   CX,DriveNum
  2830.   INT   2fh
  2831.   OR    AX,AX
  2832.   @Finish:
  2833. end;
  2834.  
  2835. { This code is from the FileCtrl Unit; copyright Borland Intl 1995      }
  2836. { Check whether drive is a RAM drive.                                   }
  2837. function IsRAMDrive(DriveNum: Integer): Boolean; assembler;
  2838. var
  2839.   TempResult: Boolean;
  2840. asm
  2841.   MOV   TempResult,False
  2842.   PUSH  DS
  2843.   MOV   BX,SS
  2844.   MOV   DS,BX
  2845.   SUB   SP,0200h
  2846.   MOV   BX,SP
  2847.   MOV   AX,DriveNum
  2848.   MOV   CX,1
  2849.   XOR   DX,DX
  2850.   INT   25h  { read boot sector }
  2851.   ADD   SP,2
  2852.   JC    @ItsNot
  2853.   MOV   BX,SP
  2854.   CMP   BYTE PTR SS:[BX+15h],0F8h  { reverify fixed disk }
  2855.   JNE   @ItsNot
  2856.   CMP   BYTE PTR SS:[BX+10h],1  { check for single FAT }
  2857.   JNE   @ItsNot
  2858.   MOV   TempResult,True
  2859.   @ItsNot:
  2860.   ADD   SP,0200h
  2861.   POP   DS
  2862.   MOV   AL, TempResult
  2863. end;
  2864.  
  2865. { This code is from the FileCtrl Unit; copyright Borland Intl 1995      }
  2866. { Finds the type of a drive letter.                                     }
  2867. function FindDriveType(DriveNum: Integer): TDriveType;
  2868. begin
  2869.   Result := TDriveType(GetDriveType(DriveNum));
  2870.   if (Result = dtFixed) or (Result = dtNetwork) then
  2871.   begin
  2872.     if IsCDROM(DriveNum) then Result := dtCDROM
  2873.     else if (Result = dtFixed) then
  2874.     begin
  2875.         { do not check for RAMDrive under Windows NT }
  2876.       if ((GetWinFlags and $4000) = 0) and IsRAMDrive(DriveNum) then
  2877.         Result := dtRAM;
  2878.     end;
  2879.   end;
  2880. end;
  2881.  
  2882. begin
  2883.   { Set the button colors to an aquamarine color scheme for drives }
  2884.   ButtonColor := clTeal;
  2885.   ButtonHLColor := clAqua;
  2886.   ButtonSColor := clNavy;
  2887.   TextColor := clblack;
  2888.   { Set initial variables before looping for all drives }
  2889.   finished := false;
  2890.   DriveNum := 0;
  2891.   while not finished do
  2892.   begin
  2893.     { Start with no drive found }
  2894.     IconType := 0;
  2895.     { Call the Borland method to get the drive info }
  2896.     DriveType := FindDriveType(DriveNum);
  2897.     { Set its letter and make it uppercase }
  2898.     DriveChar := Chr(DriveNum + ord('a'));
  2899.     DriveChar := Upcase(DriveChar);
  2900.     { Assign an icon based on the drive type; if no drive exists type is nil }
  2901.     case DriveType of
  2902.       dtFloppy  : IconType := 1;
  2903.       dtFixed   : IconType := 2;
  2904.       dtNetwork : IconType := 3;
  2905.       dtCDROM   : IconType := 4;
  2906.       dtRAM     : IconType := 5;
  2907.     end;
  2908.     { Set to check next drive letter }
  2909.     DriveNum := DriveNum + 1;
  2910.     { But if no match then out of drives so set exit flag }
  2911.     if IconType = 0 then finished := true;
  2912.     { If drive was valid then set up the New FileIconPanel on the imported }
  2913.     { Scrollbox                                                            }
  2914.     if not finished then
  2915.     begin
  2916.       { Create the FileIconPanel and set its parent for memory mgmt and display}
  2917.       TheFIP := TFileIconPanel.Create( Self );
  2918.       TheFIP.Parent := Self;
  2919.       { Call its initialize method with imported position values and the   }
  2920.       { preset color scheme, a drive caption, and a minimum font. Note the }
  2921.       { setting of the ExtraData field to non-zero; this signals a drive   }
  2922.       { rather than a file being sent in.                                  }
  2923.       TheFIP.Initialize((( XCounter - 1 ) * TheIconSpacing ),
  2924.        (( YCounter - 1  ) * TheIconSpacing ) , TheIconSize , TheIconSize , 3 ,
  2925.         7 , ButtonColor, ButtonHLColor,
  2926.        ButtonSColor , TextColor , 'DRIVE ' + DriveChar + ':' , 'MS Serif' , [] ,
  2927.        IconType );
  2928.       { Increment the column counter; if it exceeds max move to New row      }
  2929.       { Note that these are 'var' parameters and will export final position. }
  2930.       XCounter := XCounter + 1;
  2931.       if XCounter > MaxIconsInARow then
  2932.       begin
  2933.         XCounter := 1;
  2934.         YCounter := YCounter + 1;
  2935.       end;
  2936.     end;
  2937.   end;
  2938. end;
  2939.  
  2940. { This procedure assigns colors to FIP's based on file attributes }
  2941. procedure TFileIconPanelScrollBox.GetColorsForFileIcon( TheFile : String;
  2942.            var BC , HC , SC , TC : TColor );
  2943. var AmADir      ,             { Booleans hold file attribs }
  2944.     AmAnArchive ,
  2945.     AmAVolumeId ,
  2946.     AmHidden    ,
  2947.     AmReadOnly  ,
  2948.     AmSystem      : Boolean;
  2949. begin
  2950.   { Make the call to internal fileworkbench to set attributes }
  2951.   TheFWB.GetFileAttributes( TheFile , AmADir , AmAnArchive , AmAVolumeId ,
  2952.    AmHidden , AmReadOnly , AmSystem );
  2953.   { Volume ID has no subtypes }
  2954.   if AmAVolumeID then
  2955.   begin
  2956.     BC := clOlive;
  2957.     HC := clYellow;
  2958.     SC := clBlack;
  2959.     TC := clWhite;
  2960.     exit;
  2961.   end;
  2962.   { Check all directory combinations }
  2963.   if AmADir then
  2964.   begin
  2965.     BC := clNavy;
  2966.     HC := clBlue;
  2967.     SC := clBlack;
  2968.     TC := clWhite;
  2969.     if AmHidden then
  2970.     begin
  2971.       if AmReadOnly then
  2972.       begin
  2973.         if AmSystem then
  2974.         begin { One HECK of a file! }
  2975.           BC := clBlack;
  2976.           HC := clSilver;
  2977.           SC := clGray;
  2978.           TC := clWhite;
  2979.         end
  2980.         else
  2981.         begin { Dir,RO,Hid }
  2982.           BC := clMaroon;
  2983.           HC := clFuchsia;
  2984.           SC := clGreen;
  2985.           TC := clWhite;
  2986.         end;
  2987.       end
  2988.       else
  2989.       begin { Dir,Hid }
  2990.         BC := clPurple;
  2991.         HC := clFuchsia;
  2992.         SC := clBlack;
  2993.         TC := clWhite;
  2994.       end;
  2995.     end
  2996.     else
  2997.     begin
  2998.       if AmReadOnly then
  2999.       begin
  3000.         if AmSystem then
  3001.         begin { Dir,RO,Sys }
  3002.           BC := clMaroon;
  3003.           HC := clLime;
  3004.           SC := clGreen;
  3005.           TC := clWhite;
  3006.         end
  3007.         else
  3008.         begin { Dir,RO }
  3009.           BC := clGreen;
  3010.           HC := clLime;
  3011.           SC := clBlack;
  3012.           TC := clWhite;
  3013.         end;
  3014.       end
  3015.       else
  3016.       begin
  3017.         if AmSystem then
  3018.         begin { Dir,Sys }
  3019.           BC := clMaroon;
  3020.           HC := clRed;
  3021.           SC := clBlack;
  3022.           TC := clWhite;
  3023.         end;
  3024.       end;
  3025.     end;
  3026.   end
  3027.   else { Archive Only; check all combinations }
  3028.   begin
  3029.     BC := clSilver;
  3030.     HC := clWhite;
  3031.     SC := clGray;
  3032.     TC := clBlack;
  3033.     if AmHidden then
  3034.     begin
  3035.       if AmReadOnly then
  3036.       begin
  3037.         if AmSystem then
  3038.         begin { Hid,RO,Sys }
  3039.           BC := clRed;
  3040.           HC := clLime;
  3041.           SC := clPurple;
  3042.           TC := clBlack;
  3043.         end
  3044.         else
  3045.         begin { RO,Hid }
  3046.           BC := clLime;
  3047.           HC := clFuchsia;
  3048.           SC := clMaroon;
  3049.           TC := clBlack;
  3050.         end;
  3051.       end
  3052.       else
  3053.       begin { Hid }
  3054.         BC := clFuchsia;
  3055.         HC := clWhite;
  3056.         SC := clPurple;
  3057.         TC := clBlack;
  3058.       end;
  3059.     end
  3060.     else
  3061.     begin
  3062.       if AmReadOnly then
  3063.       begin
  3064.         if AmSystem then
  3065.         begin { RO,Sys }
  3066.           BC := clRed;
  3067.           HC := clLime;
  3068.           SC := clMaroon;
  3069.           TC := clBlack;
  3070.         end
  3071.         else
  3072.         begin { RO }
  3073.           BC := clLime;
  3074.           HC := clWhite;
  3075.           SC := clGreen;
  3076.           TC := clBlack;
  3077.         end;
  3078.       end
  3079.       else
  3080.       begin
  3081.         if AmSystem then
  3082.         begin { System }
  3083.           BC := clRed;
  3084.           HC := clWhite;
  3085.           SC := clMaroon;
  3086.           TC := clBlack;
  3087.         end;
  3088.       end;
  3089.     end;
  3090.   end;
  3091. end;
  3092.  
  3093. { This procedure gets all icons for an given directory, including drives and }
  3094. { standard subdirectories. It does not get special combinations or h/ro/sys  }
  3095. procedure TFileIconPanelScrollbox.GetIconsForEntireDirectory(
  3096.             TargetPath  : String );
  3097. var Finished        : Boolean;         { Loop flag              }
  3098.     TheSR           : TSearchRec;      { Searchrecord for FF/FN }
  3099.     TheResult       : Integer;         { return variable        }
  3100.     TempPath        : String;          { path for FF/FN         }
  3101.     TheFIP          : TFileIconPanel;  { generic FIP holder     }
  3102.     RowCounter    ,                    { position in row of FIP }
  3103.     ColumnCounter   : Integer;         { position in col of FIP }
  3104.     ButtonColor   ,                    { main panel color       }
  3105.     ButtonHLColor ,                    { bright panel color     }
  3106.     ButtonSColor  ,                    { dark panel color       }
  3107.     Textcolor       : TColor;          { label text color       }
  3108.     IsADir ,                           { Variable for file attr }
  3109.     IsAnArchive ,
  3110.     IsAVolumeID,
  3111.     IsAReadOnlyFile,
  3112.     IsAHiddenFile ,
  3113.     IsASystemFile     : Boolean;
  3114.     MaxTextLength     : Integer;       { Used to safely set size}
  3115. begin
  3116.   { hide during refresh }
  3117.   Visible := false;
  3118.   { Get the icon sizes }
  3119.   TheFIP := TFileIconPanel.Create( Self );
  3120.   TheFIP.Parent := Self;
  3121.   TheFIP.FTheLabel.Canvas.Font.Name := 'MS Serif';
  3122.   TheFIP.FTheLabel.Canvas.Font.Size := 7;
  3123.   MaxTextLength := TheFIP.FTheLabel.Canvas.TextWidth( 'COMMAND.COM' );
  3124.   TheFIP.Free;
  3125.   TheIconSize := MaxTextLength + 13;
  3126.   TheIconSpacing := TheIconSize + 5;
  3127.   { Set up maximum icons per row based on screen size }
  3128.   MaxIconsInARow := ( Screen.Width div TheIconSpacing );
  3129.   { Set up the position counters }
  3130.   RowCounter := 1;
  3131.   ColumnCounter := 1;
  3132.   { Get the drives for the current machine }
  3133.   AddDriveIcons( ColumnCounter , RowCounter  );
  3134.   { Set up the initial variables }
  3135.   Finished := false;
  3136.   TempPath := TargetPath + '*.*';
  3137.   { Make the call to FindFirst set to get any file; will return '.' }
  3138.   { so discard it.                                                  }
  3139.   TheResult := FindFirst( TempPath , faAnyFile , TheSR );
  3140.   { loop through all files in the directory and look for directories }
  3141.   while not Finished do
  3142.   begin
  3143.     { Make call to FindNext, using only SearchRecord from FindFirst }
  3144.     TheResult := FindNext( TheSR );
  3145.     { A -1 result means no more files so exit }
  3146.     if TheResult < 0 then finished := true else
  3147.     begin
  3148.       { Otherwise check for a directory attribute }
  3149.       if (( FileGetAttr( TargetPath + TheSR.Name ) and faDirectory ) =
  3150.        faDirectory ) then
  3151.       begin
  3152.         GetColorsForFileIcon( TargetPath + TheSR.Name , ButtonColor ,
  3153.          ButtonHLColor , ButtonSColor , TextColor );
  3154.         { If found create a New FileIconPanel on the imported scrollbox }
  3155.         { Note sending 0 ExtraData parameter to indicate file not drive }
  3156.         TheFIP := TFileIconPanel.Create( Self );
  3157.         TheFIP.Parent := Self;
  3158.         TheFIP.Initialize((( ColumnCounter - 1 ) * TheIconSpacing ),
  3159.          (( RowCounter - 1  ) * TheIconSpacing ) , TheIconSize, TheIconSize ,
  3160.           3 , 7 , ButtonColor, ButtonHLColor , ButtonSColor , TextColor ,
  3161.            TargetPath + TheSr.Name , 'MS Serif' , [] , 0 );
  3162.         { Increment column counter and move to New row if past limit }
  3163.         ColumnCounter := ColumnCounter + 1;
  3164.         if ColumnCounter > MaxIconsInARow then
  3165.         begin
  3166.           ColumnCounter := 1;
  3167.           RowCounter := RowCounter + 1;
  3168.         end;
  3169.       end;
  3170.     end;
  3171.   end;
  3172.   { Call FindClose for Windows NT/Windows 95 compatibility }
  3173.   FindClose( TheSR );
  3174.   { Set up New initialization variables }
  3175.   Finished := false;
  3176.   TempPath := TargetPath + '*.*';
  3177.   { Make needed call to FindFirst and discard '.' }
  3178.   TheResult := FindFirst( TempPath , faAnyFile , TheSR );
  3179.   while not Finished do
  3180.   begin
  3181.     { Loop through file again, this time getting only archive files }
  3182.     TheResult := FindNext( TheSR );
  3183.     { Result of -1 indicates no more files }
  3184.     if TheResult < 0 then Finished := true else
  3185.     begin
  3186.       { If faArchive file then add New FileIconPanel }
  3187.       TheFWB.GetFileAttributes(( Targetpath + TheSR.Name ) , IsADir ,
  3188.        IsAnArchive , IsAVolumeId , IsAHiddenFile , IsAReadOnlyFile ,
  3189.         IsASystemFile );
  3190.       if (( IsAnArchive ) and ( not IsADir )) then
  3191.       begin
  3192.         GetColorsForFileIcon( TargetPath + TheSR.Name , ButtonColor ,
  3193.          ButtonHLColor , ButtonSColor , TextColor );
  3194.         { Initialize New FileIconPanel and call initialize, sending 0 ED }
  3195.         TheFIP := TFileIconPanel.Create( Self );
  3196.         TheFIP.Parent := Self;
  3197.         TheFIP.Initialize((( ColumnCounter - 1 ) * TheIconSpacing ),
  3198.          (( RowCounter - 1  ) * TheIconSpacing ) , TheIconSize , TheIconSize ,
  3199.           3 , 7 , ButtonColor, ButtonHLColor , ButtonSColor , TextColor ,
  3200.            TargetPath + TheSr.Name , 'MS Serif' , [] , 0 );
  3201.         { Increment column counter and if needed row counter }
  3202.         ColumnCounter := ColumnCounter + 1;
  3203.         if ColumnCounter > MaxIconsInARow then
  3204.         begin
  3205.           ColumnCounter := 1;
  3206.           RowCounter := RowCounter + 1;
  3207.         end;
  3208.       end;
  3209.     end;
  3210.   end;
  3211.   { Call findclose for w95 and exit }
  3212.   FindClose( TheSR );
  3213.   { Reset to visible }
  3214.   Visible := true;
  3215. end;
  3216.  
  3217. { Update method for FIPscrollbox }
  3218. procedure TFileIconPanelScrollBox.Update;
  3219. begin
  3220.   IconsNeedRefreshing := true;
  3221.   { Force a repaint }
  3222.   InvalidateRect( TheStoredHandle , nil , true );
  3223. end;
  3224.  
  3225. { Create method for FIPScrollbox }
  3226. constructor TFileIconPanelScrollBox.Create( AOwner : TComponent );
  3227. begin
  3228.   inherited Create( AOwner );
  3229.   TheFWB := TFileWorkBench.Create( Self );
  3230. end;
  3231.  
  3232. { This function returns the next selected file's name }
  3233. function TFileIconPanelScrollBox.GetNextSelection( SourceDirectory : String;
  3234.                            var CurrentItem : Integer ) : String;
  3235. var TheResult    : String;      { Holds result of function }
  3236.     TheComponent : TComponent;  { Used for typecast        }
  3237.     finished     : boolean;     { Loop control variable    }
  3238.     TheComponentCount : Integer;
  3239. begin
  3240.   TheComponentCount := ComponentCount;
  3241.   { If past end of components exit with no result }
  3242.   if CurrentItem > TheComponentCount then TheResult := '' else
  3243.   begin
  3244.     { Set loop counter and run till find match or run out }
  3245.     finished := false;
  3246.     while not finished do
  3247.     begin
  3248.       { Pull component out of the list and check it }
  3249.       TheComponent := Components[ CurrentItem - 1 ];
  3250.       { Increment counter for later }
  3251.       CurrentItem := CurrentItem + 1;
  3252.       { Do the typecast with AS }
  3253.       if TheComponent is TFileIconPanel then
  3254.       with TheComponent as TFileIconPanel do
  3255.       begin
  3256.         { If its selected make sure OK }
  3257.         if Selected then
  3258.         begin
  3259.           { Don't accept backup for this level of operation }
  3260.           if FTheLabel.Caption <> '..' then
  3261.           begin
  3262.             { Otherwise return the name and abort the loop }
  3263.             TheResult := FTheName;
  3264.             finished := true;
  3265.           end;
  3266.         end
  3267.         else
  3268.         begin
  3269.           { Check to see if out of components }
  3270.           if CurrentItem > TheComponentCount then
  3271.           begin
  3272.             { If so signal error and abort }
  3273.             TheResult := '';
  3274.             finished := true;
  3275.           end;
  3276.         end;
  3277.       end;
  3278.     end;
  3279.   end;
  3280.   GetNextSelection := TheResult;
  3281. end;
  3282.  
  3283. { This procedure places a selection of files in the display based on wildcards }
  3284. procedure TFileIconPanelScrollBox.DisplayRecursiveSearchResults(
  3285.            TheStartingDirectory : String );
  3286. var XCounter ,
  3287.     YCounter   : Integer;
  3288.  
  3289. { This procedure does a recursive file search by first getting all matches (in-}
  3290. { cluding directories) and adding them to the list. Then it checks for ALL the }
  3291. { subdirectories and does the same trick on them til there are no more matches }
  3292. { and no more subdirectories, at which point it exits and recurses back up.    }
  3293. procedure RecursiveFileSearch( TheWorkingDirectory : String; var XCounter ,
  3294.                                YCounter : Integer );
  3295.  
  3296. { VITAL!!! These variables MUST be local for recursrion to work! }
  3297. var
  3298.     Finished        : Boolean;         { Loop flag              }
  3299.     TheSR           : TSearchRec;      { Searchrecord for FF/FN }
  3300.     TheResult       : Integer;         { return variable        }
  3301.     TargetPath ,
  3302.     FileMask   ,
  3303.     TheStoredWorkingDirectory ,
  3304.     ModifiedDirectory  : String;       { path for FF/FN         }
  3305.     TheFIP          : TFileIconPanel;  { generic FIP holder     }
  3306.     ButtonColor   ,                    { main panel color       }
  3307.     ButtonHLColor ,                    { bright panel color     }
  3308.     ButtonSColor  ,                    { dark panel color       }
  3309.     Textcolor       : TColor;          { label text color       }
  3310.  
  3311. begin
  3312.   { Jump out if abort pressed }
  3313.   if GlobalAbortFlag then exit;
  3314.   { Set up the initial variables }
  3315.   Finished := false;
  3316.   TheStoredWorkingDirectory := TheWorkingDirectory;
  3317.   Targetpath := ExtractFilePath( TheWorkingDirectory );
  3318.   FileMask := ExtractFileName( TheWorkingDirectory );
  3319.   { Make the call to FindFirst set to get any file }
  3320.   TheResult := FindFirst( TheWorkingDirectory , faAnyFile , TheSR );
  3321.   if TheResult < 0 then finished := true;
  3322.   if (( TheSr.Name <> '.' ) and ( TheSr.Name <> '..' ) and ( TheResult >= 0 ))
  3323.   then begin
  3324.     if (( FileGetAttr( TargetPath + TheSR.Name ) and faDirectory ) =
  3325.      faDirectory ) then
  3326.     begin { A directory }
  3327.       GetColorsForFileIcon( TargetPath + TheSR.Name , ButtonColor ,
  3328.        ButtonHLColor , ButtonSColor , TextColor );
  3329.       { If found create a New FileIconPanel on the imported scrollbox }
  3330.       { Note sending 0 ExtraData parameter to indicate file not drive }
  3331.       TheFIP := TFileIconPanel.Create( Self );
  3332.       TheFIP.Parent := Self;
  3333.       TheFIP.Initialize((( XCounter - 1 ) * TheIconSpacing ),
  3334.        (( YCounter - 1  ) * TheIconSpacing ) , TheIconSize , TheIconSize , 3 ,
  3335.         7 , ButtonColor, ButtonHLColor , ButtonSColor , TextColor , TargetPath
  3336.          + TheSr.Name , 'MS Serif' , [] , 0 );
  3337.       { Increment column counter and move to New row if past limit }
  3338.       XCounter := XCounter + 1;
  3339.       if XCounter > MaxIconsInARow then
  3340.       begin
  3341.         XCounter := 1;
  3342.         YCounter := YCounter + 1;
  3343.       end;
  3344.     end
  3345.     else
  3346.     begin { A File }
  3347.       { Set up the default color scheme for files }
  3348.       GetColorsForFileIcon( TargetPath + TheSR.Name , ButtonColor ,
  3349.        ButtonHLColor , ButtonSColor , TextColor );
  3350.       { If found create a New FileIconPanel on the imported scrollbox }
  3351.       { Note sending 0 ExtraData parameter to indicate file not drive }
  3352.       TheFIP := TFileIconPanel.Create( Self );
  3353.       TheFIP.Parent := Self;
  3354.       TheFIP.Initialize((( XCounter - 1 ) * TheIconSpacing ),
  3355.        (( YCounter - 1  ) * TheIconSpacing ) , TheIconSize, TheIconSize , 3 ,
  3356.         7 , ButtonColor, ButtonHLColor , ButtonSColor , TextColor , TargetPath
  3357.          + TheSr.Name , 'MS Serif' , [] , 0 );
  3358.       { Increment column counter and move to New row if past limit }
  3359.       XCounter := XCounter + 1;
  3360.       if XCounter > MaxIconsInARow then
  3361.       begin
  3362.         XCounter := 1;
  3363.         YCounter := YCounter + 1;
  3364.       end;
  3365.     end;
  3366.   end;
  3367.   { loop through all files in the directory and look for matches }
  3368.   while not Finished do
  3369.   begin
  3370.     { Allow keyboard processing and jump out if c-break hit }
  3371.     Application.ProcessMessages;
  3372.     if GlobalAbortFlag then exit;
  3373.     { Make call to FindNext, using only SearchRecord from FindFirst }
  3374.     TheResult := FindNext( TheSR );
  3375.     { A -1 result means no more files so exit }
  3376.     if TheResult < 0 then finished := true else
  3377.     begin
  3378.       if (( FileGetAttr( TargetPath + TheSR.Name ) and faDirectory ) =
  3379.        faDirectory ) then
  3380.       begin { A directory }
  3381.         { Set up the blue color scheme for directories }
  3382.         GetColorsForFileIcon( TargetPath + TheSR.Name , ButtonColor ,
  3383.          ButtonHLColor , ButtonSColor , TextColor );
  3384.         { If found create a New FileIconPanel on the imported scrollbox }
  3385.         { Note sending 0 ExtraData parameter to indicate file not drive }
  3386.         TheFIP := TFileIconPanel.Create( Self );
  3387.         TheFIP.Parent := Self;
  3388.         TheFIP.Initialize((( XCounter - 1 ) * TheIconSpacing ),
  3389.          (( YCounter - 1  ) * TheIconSpacing ) , TheIconSize , TheIconSize , 3 ,
  3390.            7 , ButtonColor, ButtonHLColor , ButtonSColor , TextColor ,
  3391.             TargetPath + TheSr.Name , 'MS Serif' , [] , 0 );
  3392.         { Increment column counter and move to New row if past limit }
  3393.         XCounter := XCounter + 1;
  3394.         if XCounter > MaxIconsInARow then
  3395.         begin
  3396.           XCounter := 1;
  3397.           YCounter := YCounter + 1;
  3398.         end;
  3399.       end
  3400.       else
  3401.       begin { A File }
  3402.         { Set up the default color scheme for files }
  3403.         GetColorsForFileIcon( TargetPath + TheSR.Name , ButtonColor ,
  3404.          ButtonHLColor , ButtonSColor , TextColor );
  3405.         { If found create a New FileIconPanel on the imported scrollbox }
  3406.         { Note sending 0 ExtraData parameter to indicate file not drive }
  3407.         TheFIP := TFileIconPanel.Create( Self );
  3408.         TheFIP.Parent := Self;
  3409.         TheFIP.Initialize((( XCounter - 1 ) * TheIconSpacing ),
  3410.          (( YCounter - 1  ) * TheIconSpacing ) , TheIconSize , TheIconSize , 3 ,
  3411.           7 , ButtonColor, ButtonHLColor , ButtonSColor , TextColor ,
  3412.            TargetPath + TheSr.Name , 'MS Serif' , [] , 0 );
  3413.         { Increment column counter and move to New row if past limit }
  3414.         XCounter := XCounter + 1;
  3415.         if XCounter > MaxIconsInARow then
  3416.         begin
  3417.           XCounter := 1;
  3418.           YCounter := YCounter + 1;
  3419.         end;
  3420.       end;
  3421.     end;
  3422.   end;
  3423.   { Call FindClose for Windows NT/Windows 95 compatibility }
  3424.   FindClose( TheSR );
  3425.   { Set up the variables to do recursive calls on all directories}
  3426.   Finished := false;
  3427.   ModifiedDirectory := ExtractFilePath( TheWorkingdirectory ) + '*.*';
  3428.   { Make the call to FindFirst set to get any file, ignore result }
  3429.   TheResult := FindFirst( ModifiedDirectory , faDirectory , TheSR );
  3430.   while not Finished do
  3431.   begin
  3432.     { Allow keyboard input and jump out if c-break hit }
  3433.     Application.ProcessMessages;
  3434.     if GlobalAbortFlag then exit;
  3435.     { Make call to FindNext, using only SearchRecord from FindFirst }
  3436.     TheResult := FindNext( TheSR );
  3437.     { A -1 result means no more files so exit }
  3438.     if TheResult < 0 then finished := true
  3439.     else
  3440.     begin
  3441.       if TheSR.Name <> '..' then { Ignore backup in this case }
  3442.       begin
  3443.         { Do second check due to bug in FindNext }
  3444.         if (( FileGetAttr( TargetPath + TheSR.Name ) and faDirectory )
  3445.         = faDirectory ) then
  3446.         begin
  3447.           { Set up modified directory to recurse into }
  3448.           ModifiedDirectory := ExtractFilePath( TheStoredWorkingDirectory ) +
  3449.            TheSR.Name + '\' + FileMask;
  3450.           { Perform the recursion }
  3451.           RecursiveFileSearch( ModifiedDirectory , XCounter , YCounter );
  3452.         end;
  3453.       end;
  3454.     end;
  3455.   end;
  3456. end;
  3457.  
  3458. begin
  3459.   { Keep the scrollbox from updating during refresh }
  3460.   Visible := false;
  3461.   { Make the clear call }
  3462.   ClearTheFIPs;
  3463.   XCounter := 1;
  3464.   YCounter := 1;
  3465.   { Get the drives for the current machine }
  3466.   AddDriveIcons( XCounter , YCounter );
  3467.   RecursiveFileSearch( TheStartingDirectory , XCounter , YCounter );
  3468.   { Make the scrollbox visible again }
  3469.   Visible := true;
  3470. end;
  3471.  
  3472. end.
  3473.